一般化された関数は次のとおりです。
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)あまり変化がない場合、、、...で多くの時間がかかります。したがって、ここに別のアプローチがあり、ここは非常に似ていますが、すべてを含む行を見つけるための別の関数がありますの要素。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引数はの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