在R中的矩阵中查找模式答案

【问题标题】：Finding pattern in a matrix in R在R中的矩阵中查找模式
【发布时间】：2013-01-04 10:03:41
【问题描述】：

例如，我有一个 8 x n 矩阵

set.seed(12345)
m <- matrix(sample(1:50, 800, replace=T), ncol=8)
head(m)

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]   37   15   30    3    4   11   35   31
[2,]   44   31   45   30   24   39    1   18
[3,]   39   49    7   36   14   43   26   24
[4,]   45   31   26   33   12   47   37   15
[5,]   23   27   34   29   30   34   17    4
[6,]    9   46   39   34    8   43   42   37

我想在矩阵中找到某种模式，例如我想知道在哪里可以找到 37，下一行是 10 和 29，后面的行是 42

例如，在上述矩阵的第 57:59 行中会发生这种情况

m[57:59,]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]  *37   35    1   30   47    9   12   39
[2,]    5   22  *10  *29   13    5   17   36
[3,]   22   43    6    2   27   35  *42   50

一个（可能是低效的）解决方案是获取所有包含 37 的行

sapply(1:nrow(m), function(x){37 %in% m[x,]})

然后使用几个循环来测试其他条件。

我如何编写一个有效的函数来做到这一点，它可以推广到任何用户给定的模式（不一定超过 3 行，可能有“洞”，每行中的值数量可变等）。？

编辑：回答各种 cmets

我需要找到确切的模式
同一行中的顺序无关紧要（如果它使事情更容易，可以在每一行中对值进行排序）
线条必须相邻。
我想获取所有返回的模式的（开始）位置（即，如果模式在矩阵中多次出现，我需要多个返回值）。
用户将通过 GUI 输入模式，我还没有决定如何。例如，要搜索上述模式，他可能会写类似

37;10,29;42

其中; 代表新行，, 分隔同一行上的值。同样我们可以寻找

50,51;;75;80,81

表示第 n 行中的 50 和 51，第 n+2 行中的 75，以及第 n+3 行中的 80 和 81

【问题讨论】：

一种可能的快速优化是通过查找第一个值（在您的示例中为 37）和最后一个值（在您的示例中为 42）来截断矩阵。
@csgillespie：好点子！
@Arun：是的，我正在寻找 exact 模式
10 和 29 的顺序重要吗？
我认为问题变成了：用户输入应该是什么？怎么样？

标签： r matrix

【解决方案1】：

这很容易阅读，希望对你来说足够概括：

has.37 <- rowSums(m == 37) > 0
has.10 <- rowSums(m == 10) > 0
has.29 <- rowSums(m == 29) > 0
has.42 <- rowSums(m == 42) > 0

lag <- function(x, lag) c(tail(x, -lag), c(rep(FALSE, lag)))

which(has.37 & lag(has.10, 1) & lag(has.29, 1) & lag(has.42, 2))
# [1] 57

编辑：这是一个可以使用正滞后和负滞后的概括：

find.combo <- function(m, pattern.df) {

   lag <- function(v, i) {
      if (i == 0) v else
      if (i > 0)  c(tail(v, -i), c(rep(FALSE, i))) else
      c(rep(FALSE, -i), head(v, i))
   }

   find.one <- function(x, i) lag(rowSums(m == x) > 0, i)
   matches  <- mapply(find.one, pattern.df$value, pattern.df$lag)
   which(rowSums(matches) == ncol(matches))

}

在这里测试：

pattern.df <- data.frame(value = c(40, 37, 10, 29, 42),
                         lag   = c(-1,  0,  1,  1,  2))

find.combo(m, pattern.df)
# [1] 57

Edit2：在 OP 对 GUI 输入进行编辑之后，这里有一个函数可以将 GUI 输入转换为 pattern.df 我的 find.combo 函数所期望的：

convert.gui.input <- function(string) {
   rows   <- strsplit(string, ";")[[1]]
   values <- strsplit(rows,   ",")
   data.frame(value = as.numeric(unlist(values)),
              lag = rep(seq_along(values), sapply(values, length)) - 1)
}

在这里测试：

find.combo(m, convert.gui.input("37;10,29;42"))
# [1] 57

【讨论】：

【解决方案2】：

这是一个广义函数：

PatternMatcher <- function(data, pattern, idx = NULL) {
  p <- unlist(pattern[1])
  if(is.null(idx)){
    p <- unlist(pattern[length(pattern)])
    PatternMatcher(data, rev(pattern)[-1], 
                   idx = Filter(function(n) all(p %in% intersect(data[n, ], p)),
                                1:nrow(data)))
  } else if(length(pattern) > 1) {
    PatternMatcher(data, pattern[-1], 
                   idx = Filter(function(n) all(p %in% intersect(data[n, ], p)), 
                                idx - 1))
  } else
    Filter(function(n) all(p %in% intersect(data[n, ], p)), idx - 1)
}

这是一个递归函数，它在每次迭代中减少 pattern，并且只检查在前一次迭代中识别的行之后的行。列表结构允许以方便的方式传递模式：

PatternMatcher(m, list(37, list(10, 29), 42))
# [1] 57
PatternMatcher(m, list(list(45, 24, 1), 7, list(45, 31), 4))
# [1] 2
PatternMatcher(m, list(1,3))
# [1] 47 48 93

编辑： 上面函数的想法似乎很好：检查向量pattern[[1]] 的所有行并获取索引r1，然后检查r1+1 的行pattern[[2]] 并获取@ 987654328@ 等。但是在遍历所有行时，第一步确实需要很多时间。当然，每一步都会花费很多时间，例如m <- matrix(sample(1:10, 800, replace=T), ncol=8)，即当索引没有太大变化时r1，r2，...所以这是另一种方法，这里PatternMatcher看起来非常相似，但是还有另一个函数matchRow用于查找具有vector 的所有元素的行。

matchRow <- function(data, vector, idx = NULL){
  if(is.null(idx)){
    matchRow(data, vector[-1], 
             as.numeric(unique(rownames(which(data == vector[1], arr.ind = TRUE)))))
  } else if(length(vector) > 0) {
    matchRow(data, vector[-1], 
             as.numeric(unique(rownames(which(data[idx, , drop = FALSE] == vector[1], arr.ind = TRUE)))))
  } else idx
}
PatternMatcher <- function(data, pattern, idx = NULL) {
  p <- pattern[[1]]
  if(is.null(idx)){
    rownames(data) <- 1:nrow(data)
    p <- pattern[[length(pattern)]]
    PatternMatcher(data, rev(pattern)[-1], idx = matchRow(data, p))
  } else if(length(pattern) > 1) {
    PatternMatcher(data, pattern[-1], idx = matchRow(data, p, idx - 1))
  } else
    matchRow(data, p, idx - 1)
}

与上一个函数的比较：

library(rbenchmark)
bigM <- matrix(sample(1:50, 800000, replace=T), ncol=8)
benchmark(PatternMatcher(bigM, list(37, c(10, 29), 42)), 
          PatternMatcher(bigM, list(1, 3)), 
          OldPatternMatcher(bigM, list(37, list(10, 29), 42)), 
          OldPatternMatcher(bigM, list(1, 3)), 
          replications = 10,
          columns = c("test", "elapsed"))
#                                                  test elapsed
# 4                 OldPatternMatcher(bigM, list(1, 3))   61.14
# 3 OldPatternMatcher(bigM, list(37, list(10, 29), 42))   63.28
# 2                    PatternMatcher(bigM, list(1, 3))    1.58
# 1       PatternMatcher(bigM, list(37, c(10, 29), 42))    2.02

verybigM1 <- matrix(sample(1:40, 8000000, replace=T), ncol=20)
verybigM2 <- matrix(sample(1:140, 8000000, replace=T), ncol=20)
benchmark(PatternMatcher(verybigM1, list(37, c(10, 29), 42)), 
          PatternMatcher(verybigM2, list(37, c(10, 29), 42)), 
          find.combo(verybigM1, convert.gui.input("37;10,29;42")),
          find.combo(verybigM2, convert.gui.input("37;10,29;42")),          
          replications = 20,
          columns = c("test", "elapsed"))
#                                                      test elapsed
# 3 find.combo(verybigM1, convert.gui.input("37;10,29;42"))   17.55
# 4 find.combo(verybigM2, convert.gui.input("37;10,29;42"))   18.72
# 1      PatternMatcher(verybigM1, list(37, c(10, 29), 42))   15.84
# 2      PatternMatcher(verybigM2, list(37, c(10, 29), 42))   19.62

现在pattern 参数应该类似于list(37, c(10, 29), 42) 而不是list(37, list(10, 29), 42)。最后：

fastPattern <- function(data, pattern)
  PatternMatcher(data, lapply(strsplit(pattern, ";")[[1]], 
                    function(i) as.numeric(unlist(strsplit(i, split = ",")))))
fastPattern(m, "37;10,29;42")
# [1] 57
fastPattern(m, "37;;42")
# [1] 57  4
fastPattern(m, "37;;;42")
# [1] 33 56 77

【讨论】：

这个很有意思，我需要一些时间来详细研究它，但我喜欢这个想法
@nico，我添加了一些细节。第一步通常会花费大部分时间，但仍会提高效率。
@flodel，当然，在被integer(0) 捕获时正在这样做。但现在看来find.combo(bigM, pattern.df) 和PatternMatcher(bigM, list(37, c(10, 29), 42)) 不匹配。
您需要对输出进行排序。
@flodel，刚刚发现问题是我还在用find.combo(m, pattern.df)而不是find.combo(m, convert.gui.input("37;10,29;42"))

【解决方案3】：

因为你有整数，你可以将你的矩阵转换为字符串并使用正则表达式

ss <- paste(apply(m,1,function(x) paste(x,collapse='-')),collapse=' ')
## some funny regular expression
pattern <- '[^ \t]+[ \t]{1}[^ \t]+10[^ \t]+29[^ \t]+[ \t]{1}[^ \t]+42'
regmatches(ss,regexpr(pattern ,text=ss))
[1] "37-35-1-30-47-9-12-39 5-22-10-29-13-5-17-36 22-43-6-2-27-35-42"

 regexpr(pattern ,text=ss)
[1] 1279
attr(,"match.length")
[1] 62
attr(,"useBytes")
[1] TRUE

要查看它的实际效果，请查看this。

编辑动态构造模式

searchep <- '37;10,29;42'       #string given by the user
str1 <- '[^ \t]+[ \t]{1}[^ \t]+' 
str2 <- '[^ \t]'
hh <- gsub(';',str1,searchep)
pattern <- gsub(',',str2,hh)
pattern
[1] "37[^ \t]+[ \t]{1}[^ \t]+10[^ \t]29[^ \t]+[ \t]{1}[^ \t]+42"

test for searchep <- '37;10,29;;40'  ## we skip a line here 

pattern
[1] "37[^ \t]+[ \t]{1}[^ \t]+10[^ \t]29[^ \t]+[ \t]{1}[^ \t]+[^ \t]+[ \t]{1}[^ \t]+40"
regmatches(ss,regexpr(pattern ,text=ss))
"37-35-1-30-47-9-12-39 5-22-10-29-13-5-17-36 22-43-6-2-27-35-42-50 12-31-24-40"

Edit2 测试性能

matrix.pattern <- function(searchep='37;10,29;42' ){
 str1 <- '[^ \t]+[ \t]{1}[^ \t]+' 
 str2 <- '[^ \t]+'
 hh <- gsub(';',str1,searchep)
 pattern <- gsub(',',str2,hh)
 res <- regmatches(ss,regexpr(pattern ,text=ss))
}

system.time({ss <- paste(apply(bigM,1,function(x) paste(x,collapse='-')),collapse=' ')
             matrix.pattern('37;10,29;42')})
   user  system elapsed 
   2.36    0.01    2.40

如果大矩阵不发生变化，转化为字符串id的步骤只做一次，性能非常好。

system.time(matrix.pattern('37;10,29;42'))
   user  system elapsed 
   0.71    0.02    0.72

【讨论】：

+1 用于跳出框框思考，但我认为这可能有点难以概括和维护。
不，这很容易概括我会在你更新后展示它！但要保持也许是的，它是正则表达式！
@nico 我用一个链接更新了我的答案，也许您可以为您的应用程序受到启发。

【解决方案4】：

也许它会对某人有所帮助，但至于输入，我在想以下几点：

PatternMatcher <- function(data, ...) {
  Selecting procedure here.
}

PatternMatcher(m, c(1, 37, 2, 10, 2, 29, 4, 42))

提供给函数的第二部分依次包括应该开始的行，然后是值，然后是第二行和第二个值。例如，您现在也可以说初始行之后的第 8 行，值为 50。

您甚至可以扩展它以要求每个值的特定 X、Y 坐标（因此每个值传递 3 个项目）。

【讨论】：

list(37, c(10, 29), 42) 对我来说似乎更自然。
这是一个更具体的情况，如果你想将它推广到任何线条的任何模式，那么你不能像那样缩短它。
为什么列表不概括？如果你想错过行，你可以只传递一个空向量。 list(37, c(10, 29), c(), 42)
因为它是这样的：所有奇数索引号（1,3,5等）是指示在第一行之后搜索哪一行的数字，所有偶数索引号都是要搜索的值为。
以你的方式，你不允许任何选项来搜索哪一行（也就是说，除非你想输入 10 倍的 c() 如果你对第 11 行感兴趣。

【解决方案5】：

Edit: 现在，我添加了一个更通用的函数：

这是给出所有可能组合的一种解决方案：我获得所有四个数字的所有位置，然后使用expand.grid 获得所有位置组合，然后通过检查矩阵的每一行是否等于排序矩阵的对应行。

set.seed(12345)
m <- matrix(sample(1:50, 800, replace=T), ncol=8)
head(m)
get_grid <- function(in_mat, vec_num) {
    v.idx <- sapply(vec_num, function(idx) {
        which(apply(in_mat, 1, function(x) any(x == idx)))
    })
    out <- as.matrix(expand.grid(v.idx))
    colnames(out) <- NULL
    out
}

out <- get_grid(m, c(37, 10, 29, 42))
out.s <- t(apply(out, 1, sort))

idx <- rowSums(out == out.s)
out.f <- out[idx==4, ]

> dim(out.f)
[1] 2946    4

> head(out.f)
     [,1] [,2] [,3] [,4]
[1,]    1   22   28   36
[2,]    4   22   28   36
[3,]    6   22   28   36
[4,]    9   22   28   36
[5,]   11   22   28   36
[6,]   13   22   28   36

这些是按该顺序（37、10、29、42）出现的数字的行索引。

从中，您可以检查您想要的任何组合。例如，您要求的组合可以通过以下方式完成：

cont.idx <- apply(out.f, 1, function(x) x[1] == x[2]-1 & x[2] == x[4]-1)
> out.f[cont.idx,]
[1] 57 58 58 59

【讨论】：

【解决方案6】：

这是使用sapply的一种方式：

which(sapply(seq(nrow(m)-2),
             function(x)
               isTRUE(37 %in% m[x,] & 
                      which(10 == m[x+1,]) < which(29 == m[x+1,]) & 
                      42 %in% m[x+2,])))

结果包含序列开始的所有行号：

[1] 57

【讨论】：

也许可以尝试使用我的答案将我们的两个函数结合起来给出一个通用的解决方案？

【解决方案7】：

as.data.frame(your_matrix) %>% dplyr::filter_all(dplyr::any_vars(stringr::str_detect(., pattern = "your-pattern")))

【讨论】：