Как индексировать векторную последовательность в векторной последовательности
У меня есть решение проблемы, которая включает в себя цикл и работает, но я чувствую, что мне не хватает чего-то, что связано с более эффективной реализацией. Проблема: у меня есть числовая векторная последовательность и вы хотите определить начальную позицию в другом векторе первого вектора.
Он работает следующим образом:
# 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)
Есть ли лучший способ реализовать matchSequence()
?
Добавлен
"Лучше" здесь может означать использование более элегантных методов, о которых я не думал, но даже лучше, означал бы быстрее. Попробуйте сравнить решения с:
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
Ответы
Ответ 1
И рекурсивная идея (отредактируйте с 5 по 16 февраля для работы с NA
в шаблоне):
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
И по эталону:
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
Использование больших данных:
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
Ответ 2
Вот несколько другая идея:
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)
Ответ 3
Другая идея:
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
, но она была ~ 4x как медленная.
Первая идея:
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)
Я использую all.equal
вместо identical
, потому что OP хочет, чтобы целое число 1:2
соответствовало числовому c(1,2)
. Этот подход вводит еще один случай, позволяя сопоставлять точки за пределами конца my_vec
(которые индексируются NA
):
match_seq(c(1,2,NA), my_vec) # 7
Тест 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)
Результаты:
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
Итак, alexis_laz побеждает!
(Не стесняйтесь обновлять это. См. ответ alexis для дополнительного теста.)
Ответ 4
Еще одна попытка, которая, как я считаю, быстрее повторится. Это обязано своей скоростью только проверке совпадений с точками в векторе, которые соответствуют началу последовательности поиска.
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)]
}
Результаты тестов:
#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
Ответ 5
Здесь другой способ:
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)