r - एक और वेक्टर में संख्याओं के एक वेक्टर के अनुक्रमित प्राप्त करें




vector (6)

मान लें कि हमारे पास निम्नलिखित वेक्टर हैं:

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)) का उपयोग करने की कोशिश कर रहा हूं, लेकिन यह मुझे वह नहीं दे रहा है which(v == c(2,3,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 समाधानों के आगे निरीक्षण से पता चलता है कि वे वांछित आउटपुट नहीं देते हैं। वे इसलिए बेंचमार्क में शामिल नहीं हैं।

सबसे छोटे वेक्टर बनाम के लिए बेंचमार्क:

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

चूँकि यह एक cw-answer है मैं कुछ उत्तरों के अपने स्वयं के बेंचमार्क जोड़ूँगा।

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

निचला रेखा: वास्तविक डेटा को जाने बिना, ये सभी मानक पूरी कहानी नहीं बताते हैं।


आधार 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 के पहले मान के बराबर होता है और फिर इन पदों के माध्यम से जाँच करता है कि क्या इन पदों के बाद के मान भी x के अन्य मानों के बराबर हैं।


मुझे लगता है कि लूपिंग कुशल होना चाहिए:

w = seq_along(v)
for (i in seq_along(x)) w = w[v[w+i-1L] == x[i]]

w 
# [1]  2 12

यह अतिरिक्त गति के लिए @SymbolixAU दृष्टिकोण के बाद 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

यहाँ 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) उन पदों को ढूंढता है जिन पर pattern को str भीतर देखा जाता है।
  • (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))

यहाँ दो Rcpp समाधान 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];
}')

बेंचमार्क के साथ उत्तर इन तरीकों के प्रदर्शन को दर्शाता है


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

मिलान स्थितियों का पूरा सदिश पाने के लिए:

l <- length(x)
w <- which(Reduce("+", Map('==',
                           shift(v, type = 'lead', n = 0:(l - 1)),
                           x)
                  ) == l)
rep(w, each = l) + 0:(l-1)

जो देता है:

[1]  2  3  4  5 12 13 14 15

इस उत्तर में पहले जो बेंचमार्क शामिल किया गया था, उसे एक अलग सामुदायिक विकि उत्तर में ले जाया गया है।

प्रयुक्त डेटा:

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)




vector