在R中查詢矩陣中的模式

我有一個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,]37153034113531
[2,]443145302439118
[3,]394973614432624
[4,]4531263312473715
[5,]232734293034174
[6,]94639348434237

我想在矩陣中找到一個特定的模式,例如我想知道我在哪裡可以找到一個37,其次在下一行10和29,後面是一個42

例如,在上述矩陣的第57:59行中

m[57:59,]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]*37351304791239
[2,]522*10*291351736
[3,]2243622735*4250

A(可能無效率)的解決方案是獲取包含37的所有行

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

然後使用幾個迴圈來測試其他條件.

如何寫一個有效的功能來做到這一點,這可以推廣到任何使用者給定的模式(不一定超過3行,可能的“空洞”,每行的值可變數量等).

編輯：回答各種意見

>我需要找到EXACT模式

>同一行中的順序並不重要(如果使事情更簡單,可以在每行中排序)

線必須相鄰.

>我想得到返回的所有模式的(開始)位置(即,如果模式在矩陣中多次出現,我想要多個返回值).

>使用者將通過GUI進入模式,我還沒有決定如何.例如,要搜尋上述模式,他可以寫一些類似的東西

37; 10,29; 42

在哪裡表示新行,並在同一行上分隔值.

同樣,我們可能會尋找

50,51;;75;80,81

意思是行n中的50和51,行n 2中的75,行n 3中的80和81

這是一個廣義的功能：

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)
}

這是一個遞迴函式,它是在每次迭代中減少模式,並且只檢查在上一次迭代中識別的行之後的行.列表結構允許以方便的方式傳遞模式：

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

編輯：上面的函式的想法似乎很好：檢查向量模式[[1]]的所有行,並獲得索引r1,然後檢查行r1 1為模式[[2]]並獲取r2等等,但它真的需要經歷所有行的第一步很多時間.當然,每個步驟都需要很多時間. m<- 矩陣(樣本(1:10,800,替換= T),ncol = 8),即當索引r1,r2,...沒有太大變化時,這裡是另一種方法,這裡是PatternMatcher看起來非常相似,但是還有另一個函式matchRow用於查詢具有向量的所有元素的行.

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
# 4OldPatternMatcher(bigM, list(1, 3))61.14
# 3 OldPatternMatcher(bigM, list(37, list(10, 29), 42))63.28
# 2PatternMatcher(bigM, list(1, 3))1.58
# 1PatternMatcher(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
# 1PatternMatcher(verybigM1, list(37, c(10, 29), 42))15.84
# 2PatternMatcher(verybigM2, list(37, c(10, 29), 42))19.62

現在,模式引數應該像list(37,c(10,29),42)而不是列表(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] 574
fastPattern(m, "37;;;42")
# [1] 33 56 77