Cómo indexar una secuencia vectorial dentro de una secuencia vectorial

Tengo una solución para un problema que implica bucle y funciona, pero siento que me falta algo que implica una implementación más eficiente. El problema: tengo una secuencia vectorial numérica, y quiero identificar la (s) posición (es) de inicio en otro vector del primer vector.

Funciona así:

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

¿Hay una mejor manera de implementar matchSequence() ?

Adicional

“Mejor” aquí puede significar el uso de métodos más elegantes en los que no pensé, pero aún mejor, significaría más rápido. Intente comparar soluciones para:

 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 

Y una idea recursiva (edítela el 5 de febrero de 2016 para trabajar con NA en el patrón) :

 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 

Y en un punto de referencia:

 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 

Usando datos más grandes:

 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 

Aquí hay una idea algo diferente:

 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) 

Otro bash que creo que es más rápido de nuevo. Esto debe su velocidad a solo verificar las coincidencias de los puntos en el vector que coincidan con el inicio de la secuencia buscada.

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

Resultados de referencia:

 #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 

Otra idea:

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

tapply una versión tapply , pero fue ~ 4x como lenta.


Primera idea:

 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) 

Estoy usando all.equal lugar de identical porque el OP quiere que el entero 1:2 coincida con c(1,2) numérico c(1,2) . Este enfoque introduce un caso más al permitir el emparejamiento con puntos más allá del final de my_vec (que son NA cuando se indexan):

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

El punto de referencia de 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) 

Resultados:

 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 

¡Así que las victorias de alexis_laz!

(No dude en actualizar esto. Consulte la respuesta de alexis para obtener un punto de referencia adicional).

Aquí hay otra forma:

 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)