Wie man eine Vektorsequenz innerhalb einer Vektorsequenz indiziert

Ich habe eine Lösung für ein Problem, bei dem eine Schleife verwendet wird, und funktioniert, aber ich habe das Gefühl, dass mir etwas fehlt, das eine effizientere Implementierung erfordert. Das Problem: Ich habe eine numerische Vektorsequenz und möchte die Startposition (en) in einem anderen Vektor des ersten Vektors identifizieren.

Es funktioniert so:

# helper function for matchSequence # wraps a vector by removing the first n elements and padding end with NAs wrapVector <- function(x, n) { stopifnot(n <= length(x)) if (n == length(x)) return(rep(NA, n)) else return(c(x[(n+1):length(x)], rep(NA, n))) } wrapVector(LETTERS[1:5], 1) ## [1] "B" "C" "D" "E" NA wrapVector(LETTERS[1:5], 2) ## [1] "C" "D" "E" NA NA # returns the starting index positions of the sequence found in a vector matchSequence <- function(seq, vec) { matches <- seq[1] == vec if (length(seq) == 1) return(which(matches)) for (i in 2:length(seq)) { matches <- cbind(matches, seq[i] == wrapVector(vec, i - 1)) } which(rowSums(matches) == i) } myVector <- c(3, NA, 1, 2, 4, 1, 1, 2) matchSequence(1:2, myVector) ## [1] 3 7 matchSequence(c(4, 1, 1), myVector) ## [1] 5 matchSequence(1:3, myVector) ## integer(0) 

Gibt es eine bessere Möglichkeit, matchSequence() zu implementieren?

Hinzugefügt

“Besser” kann hier bedeuten, elegantere Methoden zu verwenden, an die ich nicht gedacht habe, aber noch besser, würde schneller bedeuten. Versuchen Sie, Lösungen zu vergleichen mit:

 set.seed(100) myVector2 <- sample(c(NA, 1:4), size = 1000, replace = TRUE) matchSequence(c(4, 1, 1), myVector2) ## [1] 12 48 91 120 252 491 499 590 697 771 865 microbenchmark::microbenchmark(matchSequence(c(4, 1, 1), myVector2)) ## Unit: microseconds ## expr min lq mean median uq max naval ## matchSequence(c(4, 1, 1), myVector2) 154.346 160.7335 174.4533 166.2635 176.5845 300.453 100 

Und eine rekursive Idee (Bearbeiten am 5. Februar 16, um mit NA im Muster zu arbeiten) :

 find_pat = function(pat, x) { ff = function(.pat, .x, acc = if(length(.pat)) seq_along(.x) else integer(0L)) { if(!length(.pat)) return(acc) if(is.na(.pat[[1L]])) Recall(.pat[-1L], .x, acc[which(is.na(.x[acc]))] + 1L) else Recall(.pat[-1L], .x, acc[which(.pat[[1L]] == .x[acc])] + 1L) } return(ff(pat, x) - length(pat)) } find_pat(1:2, myVector) #[1] 3 7 find_pat(c(4, 1, 1), myVector) #[1] 5 find_pat(1:3, myVector) #integer(0) find_pat(c(NA, 1), myVector) #[1] 2 find_pat(c(3, NA), myVector) #[1] 1 

Und auf einer Benchmark:

 all.equal(matchSequence(s, my_vec2), find_pat(s, my_vec2)) #[1] TRUE microbenchmark::microbenchmark(matchSequence(s, my_vec2), flm(s, my_vec2), find_pat(s, my_vec2), unit = "relative") #Unit: relative # expr min lq median uq max neval # matchSequence(s, my_vec2) 2.970888 3.096573 3.068802 3.023167 12.41387 100 # flm(s, my_vec2) 1.140777 1.173043 1.258394 1.280753 12.79848 100 # find_pat(s, my_vec2) 1.000000 1.000000 1.000000 1.000000 1.00000 100 

Verwenden größerer Daten:

 set.seed(911); VEC = sample(c(NA, 1:3), 1e6, TRUE); PAT = c(3, 2, 2, 1, 3, 2, 2, 1, 1, 3) all.equal(matchSequence(PAT, VEC), find_pat(PAT, VEC)) #[1] TRUE microbenchmark::microbenchmark(matchSequence(PAT, VEC), flm(PAT, VEC), find_pat(PAT, VEC), unit = "relative", times = 20) #Unit: relative # expr min lq median uq max neval # matchSequence(PAT, VEC) 23.106862 20.54601 19.831344 18.677528 12.563634 20 # flm(PAT, VEC) 2.810611 2.51955 2.963352 2.877195 1.728512 20 # find_pat(PAT, VEC) 1.000000 1.00000 1.000000 1.000000 1.000000 20 

Hier ist eine etwas andere Idee:

 f < - function(seq, vec) { mm <- t(embed(vec, length(seq))) == rev(seq) ## relies on recycling of seq which(apply(mm, 2, all)) } myVector <- c(3, NA, 1, 2, 4, 1, 1, 2) f(1:2, myVector) # [1] 3 7 f(c(4,1,1), myVector) # [1] 5 f(1:3, myVector) # integer(0) 

Ein weiterer Versuch, von dem ich glaube, dass er wieder schneller ist. Dies ist darauf zurückzuführen, dass nur nach Übereinstimmungen von Punkten in dem Vektor gesucht wird, die mit dem Beginn der gesuchten Sequenz übereinstimmen.

 flm < - function(sq, vec) { hits <- which(sq[1]==vec) out <- hits[ colSums(outer(0:(length(sq)-1), hits, function(x,y) vec[x+y]) == sq)==length(sq) ] out[!is.na(out)] } 

Benchmark-Ergebnisse:

 #Unit: relative # expr min lq mean median uq max neval # josh2 2.469769 2.393794 2.181521 2.353438 2.345911 1.51641 100 # lm 1.000000 1.000000 1.000000 1.000000 1.000000 1.00000 100 

Eine andere Idee:

 match_seq2 < - function(s,v){ n = length(s) nc = length(v)-n+1 which( n == rowsum( as.integer(v[ rep(0:(n-1), nc) + rep(1:nc, each=n) ] == s), rep(seq(nc),each=n) ) ) } 

Ich habe versucht, eine tapply Version, aber es war ~ 4x so langsam.


Erste Idee:

 match_seq < - function(s, v) Filter( function(i) all.equal( s, v[i + seq_along(s) - 1] ), which( v == s[1] ) ) # examples: my_vec <- c(3, NA, 1, 2, 4, 1, 1, 2) match_seq(1:2, my_vec) # 3 7 match_seq(c(4,1,1), my_vec) # 5 match_seq(1:3, my_vec) # integer(0) 

Ich benutze all.equal anstelle von identical weil das OP will 1:2 in der numerischen c(1,2) übereinstimmen. Dieser Ansatz führt einen weiteren Fall ein, indem eine Übereinstimmung mit Punkten über das Ende von my_vec hinaus my_vec (die NA wenn sie indiziert werden):

 match_seq(c(1,2,NA), my_vec) # 7 

Der Benchmark des OP

 # variant on Josh's, suggested by OP: f2 < - function(seq, vec) { mm <- t(embed(vec, length(seq))) == rev(seq) ## relies on recycling of seq which(colSums(mm)==length(seq)) } my_check <- function(values) { all(sapply(values[-1], function(x) identical(values[[1]], x))) } set.seed(100) my_vec2 <- sample(c(NA, 1:4), size = 1000, replace = TRUE) s <- c(4,1,1) microbenchmark( op = matchSequence(s, my_vec2), josh = f(s, my_vec2), josh2 = f2(s, my_vec2), frank = match_seq(s, my_vec2), frank2 = match_seq2(s, my_vec2), jlh = matchSequence2(s, my_vec2), tlm = flm(s, my_vec2), alexis = find_pat(s, my_vec2), unit = "relative", check=my_check) 

Ergebnisse:

 Unit: relative expr min lq mean median uq max neval op 3.693609 3.505168 3.222532 3.481452 3.433955 1.9204263 100 josh 15.670380 14.756374 12.617934 14.612219 14.575440 3.1076794 100 josh2 3.115586 2.937810 2.602087 2.903687 2.905654 1.1927951 100 frank 171.824973 157.711299 129.820601 158.304789 155.009037 15.8087792 100 frank2 9.352514 8.769373 7.364126 8.607341 8.415083 1.9386370 100 jlh 215.304342 197.643641 166.450118 196.657527 200.126846 44.1745551 100 tlm 1.277462 1.323832 1.125965 1.333331 1.379717 0.2375295 100 alexis 1.000000 1.000000 1.000000 1.000000 1.000000 1.0000000 100 

Also Alexis_laz gewinnt!

(Fühlen Sie sich frei, dies zu aktualisieren. Siehe Alexis 'Antwort für einen zusätzlichen Benchmark.)

Hier ist ein anderer Weg:

 myVector < - c(3, NA, 1, 2, 4, 1, 1, 2) matchSequence <- function(seq,vec) { n.vec <- length(vec) n.seq <- length(seq) which(sapply(1:(n.vec-n.seq+1),function(i)all(head(vec[i:n.vec],n.seq)==seq))) } matchSequence(1:2,myVector) # [1] 3 7 matchSequence(c(4,1,1),myVector) # [1] 5 matchSequence(1:3,myVector) # integer(0)