假设我们有以下向量:
v <- c(2,2,3,5,8,0,32,1,3,12,5,2,3,5,8,33,1)
给定一系列数字,例如c(2,3,5,8)
,我试图找到向量v
中这个数字序列的位置。我期望的结果是:
FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE FALSE
我正在尝试使用which(v == c(2,3,5,8))
,但它并没有给我我想要的东西。
事先谢谢。
答案 0 :(得分:21)
使用base R可以执行以下操作:
v <- c(2,2,3,5,8,0,32,1,3,12,5,2,3,5,8,33,1)
x <- c(2,3,5,8)
idx <- which(v == x[1])
idx[sapply(idx, function(i) all(v[i:(i+(length(x)-1))] == x))]
# [1] 2 12
这告诉您确切的序列出现两次,从向量v
的第2和第12位开始。
它首先检查可能的起始位置,即v
等于x
的第一个值,然后遍历这些位置以检查这些位置后的值是否也等于{{的其他值1}}。
答案 1 :(得分:16)
另外两种方法使用intent
- 函数trom intent.putExtra("radiovalue", "abc" );
startactivity(intent);
:
shift
都给出了:
data.table
获得匹配位置的完整向量:
library(data.table)
# option 1
which(rowSums(mapply('==',
shift(v, type = 'lead', n = 0:(length(x) - 1)),
x)
) == length(x))
# option 2
which(Reduce("+", Map('==',
shift(v, type = 'lead', n = 0:(length(x) - 1)),
x)
) == length(x))
给出:
[1] 2 12
此答案前面包含的基准已移至单独的community wiki answer。
使用过的数据:
l <- length(x)
w <- which(Reduce("+", Map('==',
shift(v, type = 'lead', n = 0:(l - 1)),
x)
) == l)
rep(w, each = l) + 0:(l-1)
答案 2 :(得分:15)
您可以使用rollapply()
zoo
v <- c(2,2,3,5,8,0,32,1,3,12,5,2,3,5,8,33,1)
x <- c(2,3,5,8)
library("zoo")
searchX <- function(x, X) all(x==X)
rollapply(v, FUN=searchX, X=x, width=length(x))
结果TRUE
显示序列的开头
代码可以简化为rollapply(v, length(x), identical, x)
(感谢 G.Grothendieck ):
set.seed(2)
vl <- as.numeric(sample(1:10, 1e6, TRUE))
# vm <- vl[1:1e5]
# vs <- vl[1:1e4]
x <- c(2,3,5)
library("zoo")
searchX <- function(x, X) all(x==X)
i1 <- rollapply(vl, FUN=searchX, X=x, width=length(x))
i2 <- rollapply(vl, width=length(x), identical, y=x)
identical(i1, i2)
对于使用identical()
,两个参数必须属于同一类型( num 且 int 不一样)。<登记/>
如果需要==
将 int 强制转换为 num ; identical()
没有任何强制行为。
答案 3 :(得分:10)
以下是两个Rcpp
解决方案。第一个返回v
的位置,该位置是序列的起始位置。
library(Rcpp)
v <- c(2,2,3,5,8,0,32,1,3,12,5,2,3,5,8,33,1)
x <- c(2,3,5,8)
cppFunction('NumericVector SeqInVec(NumericVector myVector, NumericVector mySequence) {
int vecSize = myVector.size();
int seqSize = mySequence.size();
NumericVector comparison(seqSize);
NumericVector res(vecSize);
for (int i = 0; i < vecSize; i++ ) {
for (int j = 0; j < seqSize; j++ ) {
comparison[j] = mySequence[j] == myVector[i + j];
}
if (sum(comparison) == seqSize) {
res[i] = 1;
}else{
res[i] = 0;
}
}
return res;
}')
SeqInVec(v, x)
#[1] 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0
第二个返回序列中每个匹配条目的索引值(根据其他答案)。
cppFunction('NumericVector SeqInVec(NumericVector myVector, NumericVector mySequence) {
int vecSize = myVector.size();
int seqSize = mySequence.size();
NumericVector comparison(seqSize);
NumericVector res(vecSize);
int foundCounter = 0;
for (int i = 0; i < vecSize; i++ ) {
for (int j = 0; j < seqSize; j++ ) {
comparison[j] = mySequence[j] == myVector[i + j];
}
if (sum(comparison) == seqSize) {
for (int j = 0; j < seqSize; j++ ) {
res[foundCounter] = i + j + 1;
foundCounter++;
}
}
}
IntegerVector idx = seq(0, (foundCounter-1));
return res[idx];
}')
SeqInVec(v, x)
# [1] 2 3 4 5 12 13 14 15
正如@MichaelChirico在评论中指出的那样,可以进一步优化。例如,如果我们知道序列中的第一个条目与向量中的值不匹配,我们不需要进行其余的比较
cppFunction('NumericVector SeqInVecOpt(NumericVector myVector, NumericVector mySequence) {
int vecSize = myVector.size();
int seqSize = mySequence.size();
NumericVector comparison(seqSize);
NumericVector res(vecSize);
int foundCounter = 0;
for (int i = 0; i < vecSize; i++ ) {
if (myVector[i] == mySequence[0]) {
for (int j = 0; j < seqSize; j++ ) {
comparison[j] = mySequence[j] == myVector[i + j];
}
if (sum(comparison) == seqSize) {
for (int j = 0; j < seqSize; j++ ) {
res[foundCounter] = i + j + 1;
foundCounter++;
}
}
}
}
IntegerVector idx = seq(0, (foundCounter-1));
return res[idx];
}')
The answer with benchmarks显示了这些方法的表现
答案 4 :(得分:10)
我觉得循环应该是有效的:
w = seq_along(v)
for (i in seq_along(x)) w = w[v[w+i-1L] == x[i]]
w
# [1] 2 12
这可以在@SymbolixAU approach之后用C ++写入,以提高速度。
基本比较:
# create functions for selected approaches
redjaap <- function(v,x)
which(Reduce("+", Map('==', shift(v, type = 'lead', n = 0:(length(x) - 1)), x)) == length(x))
loop <- function(v,x){
w = seq_along(v)
for (i in seq_along(x)) w = w[v[w+i-1L] == x[i]]
w
}
# check consistency
identical(redjaap(v,x), loop(v,x))
# [1] TRUE
# check speed
library(microbenchmark)
vv <- rep(v, 1e4)
microbenchmark(redjaap(vv,x), loop(vv,x), times = 100)
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# redjaap(vv, x) 5.883809 8.058230 17.225899 9.080246 9.907514 96.35226 100 b
# loop(vv, x) 3.629213 5.080816 9.475016 5.578508 6.495105 112.61242 100 a
# check consistency again
identical(redjaap(vv,x), loop(vv,x))
# [1] TRUE
答案 5 :(得分:8)
加载所需的包:
library(data.table)
library(microbenchmark)
library(Rcpp)
library(zoo)
创建用于运行基准测试的向量:
set.seed(2)
vl <- sample(1:10, 1e6, TRUE)
vm <- vl[1:1e5]
vs <- vl[1:1e4]
x <- c(2,3,5)
测试所有解决方案是否在小向量vs
上给出相同的结果:
> all.equal(jaap1(vs,x), jaap2(vs,x))
[1] TRUE
> all.equal(jaap1(vs,x), docendo(vs,x))
[1] TRUE
> all.equal(jaap1(vs,x), a5c1(vs,x))
[1] TRUE
> all.equal(jaap1(vs,x), jogo1(vs,x))
[1] TRUE
> all.equal(jaap1(vs,x), moody(vs,x))
[1] "Numeric: lengths (24, 873) differ"
> all.equal(jaap1(vs,x), cata1(vs,x))
[1] "Numeric: lengths (24, 0) differ"
> all.equal(jaap1(vs,x), u989(vs,x))
[1] TRUE
> all.equal(jaap1(vs,x), frank(vs,x))
[1] TRUE
> all.equal(jaap1(vs,x), symb(vs,x))
[1] TRUE
> all.equal(jaap1(vs, x), symbOpt(vs, x))
[1] TRUE
对cata1
和moody
解决方案的进一步检查了解到它们没有提供所需的输出。因此,它们不包括在基准中。
最小矢量vs的基准:
mbs <- microbenchmark(jaap1(vs,x), jaap2(vs,x), docendo(vs,x), a5c1(vs,x),
jogo1(vs,x), u989(vs,x), frank(vs,x), symb(vs,x), symbOpt(vs, x),
times = 100)
给出:
print(mbs, order = "median") Unit: microseconds expr min lq mean median uq max neval symbOpt(vs, x) 40.658 47.0565 78.47119 51.5220 56.2765 2170.708 100 symb(vs, x) 106.208 112.7885 151.76398 117.0655 123.7450 1976.360 100 frank(vs, x) 121.303 129.0515 203.13616 132.1115 137.9370 6193.837 100 jaap2(vs, x) 187.973 218.7805 322.98300 235.0535 255.2275 6287.548 100 jaap1(vs, x) 306.944 341.4055 452.32426 358.2600 387.7105 6376.805 100 a5c1(vs, x) 463.721 500.9465 628.13475 516.2845 553.2765 6179.304 100 docendo(vs, x) 1139.689 1244.0555 1399.88150 1313.6295 1363.3480 9516.529 100 u989(vs, x) 8048.969 8244.9570 8735.97523 8627.8335 8858.7075 18732.750 100 jogo1(vs, x) 40022.406 42208.4870 44927.58872 43733.8935 45008.0360 124496.190 100
媒介向量的基准vm
:
mbm <- microbenchmark(jaap1(vm,x), jaap2(vm,x), docendo(vm,x), a5c1(vm,x),
jogo1(vm,x), u989(vm,x), frank(vm,x), symb(vm,x), symbOpt(vm, x),
times = 100)
给出:
print(mbm, order = "median") Unit: microseconds expr min lq mean median uq max neval symbOpt(vm, x) 357.452 405.0415 974.9058 763.0205 1067.803 7444.126 100 symb(vm, x) 1032.915 1117.7585 1923.4040 1422.1930 1753.044 17498.132 100 frank(vm, x) 1158.744 1470.8170 1829.8024 1826.1330 1935.641 6423.966 100 jaap2(vm, x) 1622.183 2872.7725 3798.6536 3147.7895 3680.954 14886.765 100 jaap1(vm, x) 3053.024 4729.6115 7325.3753 5607.8395 6682.814 87151.774 100 a5c1(vm, x) 5487.547 7458.2025 9612.5545 8137.1255 9420.684 88798.914 100 docendo(vm, x) 10780.920 11357.7440 13313.6269 12029.1720 13411.026 21984.294 100 u989(vm, x) 83518.898 84999.6890 88537.9931 87675.3260 90636.674 105681.313 100 jogo1(vm, x) 471753.735 512979.3840 537232.7003 534780.8050 556866.124 646810.092 100
最大向量vl
的基准:
mbl <- microbenchmark(jaap1(vl,x), jaap2(vl,x), docendo(vl,x), a5c1(vl,x),
jogo1(vl,x), u989(vl,x), frank(vl,x), symb(vl,x), symbOpt(vl, x),
times = 100)
给出:
print(mbl, order = "median") Unit: milliseconds expr min lq mean median uq max neval symbOpt(vl, x) 4.679646 5.768531 12.30079 6.67608 11.67082 118.3467 100 symb(vl, x) 11.356392 12.656124 21.27423 13.74856 18.66955 149.9840 100 frank(vl, x) 13.523963 14.929656 22.70959 17.53589 22.04182 132.6248 100 jaap2(vl, x) 18.754847 24.968511 37.89915 29.78309 36.47700 145.3471 100 jaap1(vl, x) 37.047549 52.500684 95.28392 72.89496 138.55008 234.8694 100 a5c1(vl, x) 54.563389 76.704769 116.89269 89.53974 167.19679 248.9265 100 docendo(vl, x) 109.824281 124.631557 156.60513 129.64958 145.47547 296.0214 100 u989(vl, x) 1380.886338 1413.878029 1454.50502 1436.18430 1479.18934 1632.3281 100 jogo1(vl, x) 4067.106897 4339.005951 4472.46318 4454.89297 4563.08310 5114.4626 100
每种解决方案的使用功能:
jaap1 <- function(v,x) {
l <- length(x);
w <- which(rowSums(mapply('==', shift(v, type = 'lead', n = 0:(length(x) - 1)), x) ) == length(x));
rep(w, each = l) + 0:(l-1)
}
jaap2 <- function(v,x) {
l <- length(x);
w <- which(Reduce("+", Map('==', shift(v, type = 'lead', n = 0:(length(x) - 1)), x)) == length(x));
rep(w, each = l) + 0:(l-1)
}
docendo <- function(v,x) {
l <- length(x);
idx <- which(v == x[1]);
w <- idx[sapply(idx, function(i) all(v[i:(i+(length(x)-1))] == x))];
rep(w, each = l) + 0:(l-1)
}
a5c1 <- function(v,x) {
l <- length(x);
w <- which(colSums(t(embed(v, l)[, l:1]) == x) == l);
rep(w, each = l) + 0:(l-1)
}
jogo1 <- function(v,x) {
l <- length(x);
searchX <- function(x, X) all(x==X);
w <- which(rollapply(v, FUN=searchX, X=x, width=l));
rep(w, each = l) + 0:(l-1)
}
moody <- function(v,x) {
l <- length(x);
v2 <- as.numeric(factor(c(v,NA),levels = x));
v2[is.na(v2)] <- l+1;
which(diff(v2) == 1)
}
cata1 <- function(v,x) {
l <- length(x);
w <- which(sapply(lapply(seq(length(v)-l)-1, function(i) v[seq(x)+i]), identical, x));
rep(w, each = l) + 0:(l-1)
}
u989 <- function(v,x) {
l <- length(x);
s <- paste(v, collapse = '-');
p <- paste0('\\b', paste(x, collapse = '-'), '\\b');
i <- c(1, unlist(gregexpr(p, s)));
m <- substring(s, head(i,-1), tail(i,-1));
ln <- lengths(strsplit(m, '-'));
w <- cumsum(c(ln[1], ln[-1]-1));
rep(w, each = l) + 0:(l-1)
}
frank <- function(v,x) {
l <- length(x);
w = seq_along(v);
for (i in seq_along(x)) w = w[v[w+i-1L] == x[i]];
rep(w, each = l) + 0:(l-1)
}
cppFunction('NumericVector SeqInVec(NumericVector myVector, NumericVector mySequence) {
int vecSize = myVector.size();
int seqSize = mySequence.size();
NumericVector comparison(seqSize);
NumericVector res(vecSize);
int foundCounter = 0;
for (int i = 0; i < vecSize; i++ ) {
for (int j = 0; j < seqSize; j++ ) {
comparison[j] = mySequence[j] == myVector[i + j];
}
if (sum(comparison) == seqSize) {
for (int j = 0; j < seqSize; j++ ) {
res[foundCounter] = i + j + 1;
foundCounter++;
}
}
}
IntegerVector idx = seq(0, (foundCounter-1));
return res[idx];
}')
symb <- function(v,x) {SeqInVec(v, x)}
cppFunction('NumericVector SeqInVecOpt(NumericVector myVector, NumericVector mySequence) {
int vecSize = myVector.size();
int seqSize = mySequence.size();
NumericVector comparison(seqSize);
NumericVector res(vecSize);
int foundCounter = 0;
for (int i = 0; i < vecSize; i++ ) {
if (myVector[i] == mySequence[0]) {
for (int j = 0; j < seqSize; j++ ) {
comparison[j] = mySequence[j] == myVector[i + j];
}
if (sum(comparison) == seqSize) {
for (int j = 0; j < seqSize; j++ ) {
res[foundCounter] = i + j + 1;
foundCounter++;
}
}
}
}
IntegerVector idx = seq(0, (foundCounter-1));
return res[idx];
}')
symbOpt <- function(v,x) {SeqInVecOpt(v,x)}
由于这是一个简单的回答,我将添加我自己的一些答案的基准。
library(data.table)
library(microbenchmark)
set.seed(2); v <- sample(1:100, 5e7, TRUE); x <- c(2,3,5)
jaap1 <- function(v, x) {
which(rowSums(mapply('==',shift(v, type = 'lead', n = 0:(length(x) - 1)),
x)) == length(x))
}
jaap2 <- function(v, x) {
which(Reduce("+", Map('==',shift(v, type = 'lead', n = 0:(length(x) - 1)),
x)) == length(x))
}
dd1 <- function(v, x) {
idx <- which(v == x[1])
idx[sapply(idx, function(i) all(v[i:(i+(length(x)-1))] == x))]
}
dd2 <- function(v, x) {
idx <- which(v == x[1L])
xl <- length(x) - 1L
idx[sapply(idx, function(i) all(v[i:(i+xl)] == x))]
}
frank <- function(v, x) {
w = seq_along(v)
for (i in seq_along(x)) w = w[v[w+i-1L] == x[i]]
w
}
all.equal(jaap1(v, x), dd1(v, x))
all.equal(jaap2(v, x), dd1(v, x))
all.equal(dd2(v, x), dd1(v, x))
all.equal(frank(v, x), dd1(v, x))
bm <- microbenchmark(jaap1(v, x), jaap2(v, x), dd1(v, x), dd2(v, x), frank(v, x),
unit = "relative", times = 25)
plot(bm)
bm
Unit: relative
expr min lq mean median uq max neval
jaap1(v, x) 4.487360 4.591961 4.724153 4.870226 4.660023 3.9361093 25
jaap2(v, x) 2.026052 2.159902 2.116204 2.282644 2.138106 2.1133068 25
dd1(v, x) 1.078059 1.151530 1.119067 1.257337 1.201762 0.8646835 25
dd2(v, x) 1.000000 1.000000 1.000000 1.000000 1.000000 1.0000000 25
frank(v, x) 1.400735 1.376405 1.442887 1.427433 1.611672 1.3440097 25
底线:在不知道真实数据的情况下,所有这些基准测试并不能说明整个故事。
答案 6 :(得分:4)
这是一个利用data.table
中二级索引的二进制搜索的解决方案。 (Great vignette here)
这种方法有相当大的开销,因此它在基准测试中的1e4长度向量上并不是特别具有竞争力,但随着大小的增加,它会挂在最靠近的顶层。
向所有发布解决方案的人致敬,从这个问题中学到很多东西。
matt <- function(v,x){
l <- length(x);
SL <- seq_len(l-1);
DT <- data.table(Seq_0 = v);
for (i in SL) set(DT, j = eval(paste0("Seq_",i)), value = shift(DT[["Seq_0"]],n = i, type = "lead"));
w <- DT[as.list(x),on = paste0("Seq_",c(0L,SL)), which = TRUE];
rep(w, each = l) + 0:(l-1)
}
library(data.table)
library(microbenchmark)
library(Rcpp)
library(zoo)
set.seed(2)
vl <- sample(1:10, 1e6, TRUE)
vm <- vl[1:1e5]
vs <- vl[1:1e4]
x <- c(2,3,5)
Unit: microseconds
expr min lq mean median uq max neval
symb(vs, x) 138.342 143.048 161.6681 153.1545 159.269 259.999 10
frank(vs, x) 176.634 184.129 198.8060 193.2850 200.701 257.050 10
jaap2(vs, x) 282.231 299.025 342.5323 316.5185 337.760 524.212 10
jaap1(vs, x) 490.013 528.123 568.6168 538.7595 547.268 731.340 10
a5c1(vs, x) 706.450 742.270 751.3092 756.2075 758.859 793.446 10
dd2(vs, x) 1319.098 1348.082 2061.5579 1363.2265 1497.960 7913.383 10
docendo(vs, x) 1427.768 1459.484 1536.6439 1546.2135 1595.858 1696.070 10
dd1(vs, x) 1377.502 1406.272 2217.2382 1552.5030 1706.131 8084.474 10
matt(vs, x) 1928.418 2041.597 2390.6227 2087.6335 2430.470 4762.909 10
u989(vs, x) 8720.330 8821.987 8935.7188 8882.0190 9106.705 9163.967 10
jogo1(vs, x) 47123.615 47536.700 49158.2600 48449.2390 50957.035 52496.981 10
Unit: milliseconds
expr min lq mean median uq max neval
symb(vm, x) 1.319921 1.378801 1.464972 1.423782 1.577006 1.682156 10
frank(vm, x) 1.671155 1.739507 1.806548 1.760738 1.844893 2.097404 10
jaap2(vm, x) 2.298449 2.380281 2.683813 2.432373 2.566581 4.310258 10
matt(vm, x) 3.195048 3.495247 3.577080 3.607060 3.687222 3.844508 10
jaap1(vm, x) 4.079117 4.179975 4.776989 4.496603 5.206452 6.295954 10
a5c1(vm, x) 6.488621 6.617709 7.366226 6.720107 6.877529 12.500510 10
dd2(vm, x) 12.595699 12.812876 14.990739 14.058098 16.758380 20.743506 10
docendo(vm, x) 13.635357 13.999721 15.296075 14.729947 16.151790 18.541582 10
dd1(vm, x) 13.474589 14.177410 15.676348 15.446635 17.150199 19.085379 10
u989(vm, x) 94.844298 95.026733 96.309658 95.134400 97.460869 100.536654 10
jogo1(vm, x) 575.230741 581.654544 621.824297 616.474265 628.267155 723.010738 10
Unit: milliseconds
expr min lq mean median uq max neval
symb(vl, x) 13.34294 13.55564 14.01556 13.61847 14.78210 15.26076 10
frank(vl, x) 17.35628 17.45602 18.62781 17.56914 17.88896 25.38812 10
matt(vl, x) 20.79867 21.07157 22.41467 21.23878 22.56063 27.12909 10
jaap2(vl, x) 22.81464 22.92414 22.96956 22.99085 23.02558 23.10124 10
jaap1(vl, x) 40.00971 40.46594 43.01407 41.03370 42.81724 55.90530 10
a5c1(vl, x) 65.39460 65.97406 69.27288 66.28000 66.72847 83.77490 10
dd2(vl, x) 127.47617 132.99154 161.85129 134.63168 157.40028 342.37526 10
dd1(vl, x) 140.06140 145.45085 154.88780 154.23280 161.90710 171.60294 10
docendo(vl, x) 147.07644 151.58861 162.20522 162.49216 165.49513 183.64135 10
u989(vl, x) 2022.64476 2041.55442 2055.86929 2054.92627 2066.26187 2088.71411 10
jogo1(vl, x) 5563.31171 5632.17506 5863.56265 5872.61793 6016.62838 6244.63205 10
答案 7 :(得分:2)
以下是base R
中基于字符串的方法:
str <- paste(v, collapse = '-')
# "2-2-3-5-8-0-32-1-3-12-5-2-3-5-8-33-1"
pattern <- paste0('\\b', paste(x, collapse = '-'), '\\b')
# "\\b2-3-5-8\\b"
inds <- unlist(gregexpr(pattern, str)) # (1)
# 3 25
sapply(inds, function(i) lengths(strsplit(substr(str, 1, i),'-'))) # (2)
# [1] 2 12
\\b
用于完全匹配。pattern
内str
的位置。v
中的各个索引。<强>更新强>
至于运行时效率的讨论,这是一个快得多的解决方案,而不是我的第一个解决方案:
str <- paste(v, collapse = '-')
pattern <- paste0('\\b', paste(x, collapse = '-'), '\\b')
inds <- c(1, unlist(gregexpr(pattern, str)))
m <- substring(str, head(inds,-1), tail(inds,-1))
ln <- lengths(strsplit(m, '-'))
cumsum(c(ln[1], ln[-1]-1))
答案 8 :(得分:1)
编辑 :有些人注意到我的答案并不总能提供所需的输出,我可能会稍后解决,同时要小心!
我们可以将v
转换为因子,并且只在变换后的矢量中保留连续值:
v2 <- as.numeric(factor(c(v,NA),levels = x)) # [1] 1 1 2 3 4 NA NA NA ...
v2[is.na(v2)] <- length(x)+1 # [1] 1 1 2 3 4 5 5 5 ...
output <- diff(v2) ==1
# [1] FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE FALSE
数据强>
v <- c(2,2,3,5,8,0,32,1,3,12,5,2,3,5,8,33,1)
x <- c(2,3,5,8)
答案 9 :(得分:0)
我修改了@talat的解决方案,因为我发现这并非在所有情况下都有效。首先,如果idx[sapply(idx, function(i) all(v[i:(i+(length(x)-1))] == x))]
包含NA且没有FALSE,则此步骤v[i:(i+(length(x)-1))] == x))
将产生NA。其次,为了匹配期望的结果,我使用索引创建了期望的最终逻辑向量。
seq_detect <- function(v, x) {
#If the integer is not detected then return early a vector of all falses
if(!any(v == x[1])){
return(vector(length = length(v)))
}
#Create an index of v where the first value in x appears
idx <- which(v == x[1])
#See if each of those indices do indeed match the whole pattern
index_seq_start_raw <- idx[sapply(idx, function(i) all(v[i:(i+(length(x)-1))] == x))]
#These may return NAs if above index outside range of 1:length(v)
if(all(is.na(index_seq_start_raw))){
return(vector(length = length(v)))
}
#If some NAs then remove these
(index_seq_start <- index_seq_start_raw[!is.na(index_seq_start_raw)])
#Create template of FALSES for output
output <- vector(length = length(v))
#Loop over index_seq_start and replace any matches with TRUEs
for(i in seq_along(1:length(index_seq_start))){
output[(index_seq_start[i]):(index_seq_start[i]+3)] <- TRUE
}
output
}
#This works on both the following pairs of vectors, where as due to indexing
#issues @talat's solution causes an error with v1 and x1.
v <- c(2, 2, 3, 5, 8, 0, 32, 1, 3, 12, 5, 2, 3, 5, 8, 33, 1)
x <- c(2, 3, 5, 8)
[1] FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE FALSE
v1 <- c(1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1)
x1 <- c(1, 2, 2, 1)
[1] FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE