15

例如，我有一个 8 xn 矩阵

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 行，可能有“洞”，每行中的值数量可变等）。？

编辑：回答各种评论

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

37;10,29;42

where;代表一个新行并,分隔同一行上的值。同样我们可以寻找

50,51;;75;80,81

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

4

7 回答 7

5

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

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.dfmyfind.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
于 2013-01-04T12:09:00.373 回答
4

这是一个通用函数：

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等。但是在遍历所有行时，第一步确实需要很多时间。当然，每一步都会花费很多时间 eg ，即当索引没有太大变化时，......所以这是另一种方法，这里看起来非常相似，但是还有另一个函数可以找到所有的行的元素。pattern[[2]]r2m <- matrix(sample(1:10, 800, replace=T), ncol=8)r1r2PatternMatchermatchRowvector

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论点也应该是 likelist(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
于 2013-01-04T12:32:59.473 回答
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

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

编辑动态构造模式

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
于 2013-01-04T12:44:58.420 回答
2

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

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

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

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

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

于 2013-01-04T10:34:07.543 回答
2

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

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

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
于 2013-01-04T11:49:52.303 回答
1

这是一种使用方法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
于 2013-01-04T10:28:37.140 回答
0

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

于 2019-11-27T22:39:12.630 回答