我有一个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行，可能有“漏洞”，每行中有可变数量的值等）。？< / p>
编辑：回答各种评论
37;10,29;42
;表示新行，,分隔同一行的值。
同样，我们可能会寻找
50,51;;75;80,81
第n行含义50和51，第n + 2行含义75，第n + 3行含义为80和81
答案 0 :(得分：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：，这是一个将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
答案 1 :(得分：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 pattern[[2]]并获取r2等等。但是在执行所有行时，第一步需要花费很多时间。当然，每一步都需要花费很多时间。 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
答案 2 :(得分：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
答案 3 :(得分：2)
也许它会对某人有所帮助，但就投入而言，我正在考虑以下事项：
PatternMatcher <- function(data, ...) {
Selecting procedure here.
}
PatternMatcher(m, c(1, 37, 2, 10, 2, 29, 4, 42))
输入函数的第二部分按顺序包括它应该开始的行，然后是值，然后是第二行和第二个值。你现在也可以说例如第一行之后的第8行，值为50。
你甚至可以扩展它以询问每个值的特定X，Y坐标（因此每个值传递给函数的3个项目）。
答案 4 :(得分：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
答案 5 :(得分：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
答案 6 :(得分：0)
as.data.frame（your_matrix）％>％ dplyr :: filter_all（dplyr :: any_vars（stringr :: str_detect（。，pattern =“ your-pattern”）））