获取另一个向量中的数字向量的索引

时间:2018-02-07 09:48:42

标签: r vector

假设我们有以下向量:

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)),但它并没有给我我想要的东西。

事先谢谢。

10 个答案:

答案 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

cata1moody解决方案的进一步检查了解到它们没有提供所需的输出。因此,它们不包括在基准中。

最小矢量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)

Imgur

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)

矢量长度1e4

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

矢量长度1e5

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

矢量长度1e6

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用于完全匹配。
  • (1)查找patternstr的位置。
  • (2)取回原始载体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