10

I want to check if a list (or a vector, equivalently) is contained into another one, not if it is a subset of thereof. Let us assume we have

r <- c(1,1)
s <- c(5,2)
t <- c(1,2,5)

The function should behave as follows:

is.contained(r,t) 
[1] FALSE
# as (1,1) is not contained in (1,2,5) since the former 
# contains two 1 whereas the latter only one.

is.contained(s,t)
[1] TRUE

The operator %in% checks for subsets, hence it would return TRUE in both cases, likewise all or any. I am sure there is a one-liner but I just do not see it.

1
  • Nice question, but why call it a list when R has a list class? Dec 24, 2016 at 18:39

4 Answers 4

3

How about using a loop. I iterate over the first vector and check if it is present in the second vector. If it is there i remove it from second vector. And the process continues.

is.contained=function(vec1,vec2){
    x=vector(length = length(vec1))
    for (i in 1:length(vec1)) {
        x[i] = vec1[i] %in% vec2
        if(length(which(vec1[i] %in% vec2)) == 0) vec2 else 
            vec2=vec2[-match(vec1[i], vec2)]
    }
    y=all(x==T)
    return(y)
}
5
  • This gives incorrect results. Let vec1 = c(1,1,3,3) and vec2 = c(1,1,1,3), your function returns TRUE (should be FALSE as vec2 only has one 3). Also, this approach is very inefficient. Objects that constantly change size should be avoided in R. Check out Chapter 2 of R_inferno. Dec 26, 2016 at 17:55
  • This should work now. Im pre-allocating a vector of length equal to the first vector, so im not growing any thing inside the function. Dec 27, 2016 at 3:26
  • I've updated my answer to include your function now. Nice job correcting your algorithm, however, it is still very slow as it inherently relies on repeatedly modifying the size of vec2. Dec 27, 2016 at 19:00
  • I agree its very slow and you should probably remove it from the benchmark. i gave an anwser thinking many anwser here were falling short. This wont fail, anyways i will try to get a better solution. Dec 28, 2016 at 5:26
  • I disagree!!! Your answer is very intuitive and gives correct results (something that has proven to be difficult) in a completely different manner than any other answer posted here. This add educational opportunities for others. Also I was thinking this approach is well suited to be adapted to an Rcpp version. +1 Dec 28, 2016 at 6:01
2

The sets functions (e.g. intersect, union, etc.) from base R give results consistent with set theory. Sets technically don't have repeating elements, thus the vector c(1,1,2) and c(1,2) are considered the same when it comes to sets (see Set (Mathematics)). This is the main problem this question faces and thus why some of the solutions posted here fail (including my previous attempts). The solution to the OP's question is found somewhere between understanding sets and sequences. Although sequences allow repetition, order matters, and here we don't care (order doesn't matter in sets).

Below, I have provided a vector intersect function (VectorIntersect) that returns all of the common elements between two vectors regardless of order or presence of duplicates. Also provided is a containment function called is.contained, which calls VectorIntersect, that will determine if all of the elements in one vector are present in another vector.

VectorIntersect <- function(v,z) {
    unlist(lapply(unique(v[v%in%z]), function(x) rep(x,min(sum(v==x),sum(z==x)))))
}
is.contained <- function(v,z) {length(VectorIntersect(v,z))==length(v)}

Let's look at a simple example:

r <- c(1, 1)
s <- c(rep(1, 5), rep("a", 5))
s
[1] "1" "1" "1" "1" "1" "a" "a" "a" "a" "a"

VectorIntersect(r, s)
[1] 1 1
is.contained(r, s)  ## r is contained in s
[1] TRUE
is.contained(s, r)  ## s is not contained in r
[1] FALSE
is.contained(s, s)  ## s is contained in itself.. more on this later
[1] TRUE

Now, let's look at @Gennaro's clever recursive approach which gives correct results (Many apologies and also many Kudos... on earlier tests, I was under the impression that it was checking to see if b was contained in s and not the other way around):

fun.contains(s, r)  ## s contains r
[1] TRUE
fun.contains(r, s)  ## r does not contain s
[1] FALSE
fun.contains(s, s)  ## s contains s
[1] TRUE

We will now step through the other set-based algorithms and see how they handle r and s above. I have added print statements to each function for clarity. First, @Jilber's function.

is.containedJilber <- function(x,y){
    temp <- intersect(x,y)
    print(temp); print(length(x)); print(length(temp)); print(all.equal(x, temp))
    out <- ifelse(length(x)==length(temp), all.equal(x, temp), FALSE)
    return(out)  
}

is.containedJilber(r, s)   ## should return TRUE but does not
[1] "1"                    ## result of intersect
[1] 2                      ## length of r
[1] 1                      ## length of temp

## results from all.equal.. gives weird results because lengths are different
[1] "Modes: numeric, character"    "Lengths: 2, 1"     "target is numeric, current is character"

[1] FALSE                  ## results from the fact that 2 does not equal 1

is.containedJilber(s, s)    ## should return TRUE but does not
[1] "1" "a"                 ## result of intersect
[1] 10                      ## length of s
[1] 2                       ## length of temp

## results from all.equal.. again, gives weird results because lengths are different
[1] "Lengths (10, 2) differ (string compare on first 2)" "1 string mismatch" 

[1] FALSE                  ## results from the fact that 10 does not equal 2

Here is @Simon's:

is.containedSimon <- function(x, y) {
    print(setdiff(x, y))
    z <- x[x %in%setdiff(x, y)]
    print(z); print(length(x)); print(length(y)); print(length(z))
    length(z) == length(x) - length(y)
}

is.containedSimon(s, r)    ## should return TRUE but does not
[1] "a"                    ## result of setdiff
[1] "a" "a" "a" "a" "a"    ## the elements in s that match the result of setdiff
[1] 10                     ## length of s
[1] 2                      ## length of r
[1] 5                      ## length of z
[1] FALSE                  ## result of 5 not being equal to 10 - 2

Hopefully this illustrates the pitfalls of applying strict set operations in this setting.

Let's test for efficiency and equality. Below, we build many test vectors and check to see if they are contained in either the vector testContainsNum (if it's a number vector) or testContainsAlpha (if it is a character vector):

set.seed(123)
testContainsNum <- sample(20:40, 145, replace=TRUE)       ## generate large vector with random numbers
testContainsAlpha <- sample(letters, 175, replace=TRUE)   ## generate large vector with random letters

tVec <- lapply(1:1000, function(x) {   ## generating test data.. 
    if (x%%2==0) {
        sample(20:40, sample(50:100, 1), replace=TRUE)  ## even indices will contain numbers
    } else {
        sample(letters, sample(50:90, 1), replace=TRUE)  ## odd indices will contain characters
    }
})

tContains <- lapply(1:1000, function(x) if (x%%2==0) {testContainsNum} else {testContainsAlpha})

## First check equality
tJoe <- mapply(is.contained, tVec, tContains)
tGennaro <- mapply(fun.contains, tContains, tVec)
tSimon <- mapply(is.containedSimon, tContains, tVec)
tJilber <- mapply(is.containedJilber, tVec, tContains)

all(tJoe==tGennaro)  ## Give same results
[1] TRUE

## Both Jilber's and Simon's solution don't return any TRUE values
any(tJilber)
[1] FALSE
any(tSimon)
[1] FALSE

## There should be 170 TRUEs
sum(tJoe)
[1] 170

Let's take a closer look to determine if is.contained and fun.contains are behaving correctly.

table(tVec[[3]])
a  b  c     e  f  g  h  i  j  k  l  m  n  o  p  q  r     t  u  v  w  x  y  z 
3  4  5     2  2  1  5  3  5  3  2  1  7  3  1  2  4     3  5  5  2  4  3  3

table(tContains[[3]])
a  b  c  d  e  f  g  h  i  j  k  l  m  n  o  p  q  r  s  t  u  v  w  x  y  z 
4 11  4  3  7  8 13  4  4  9 13  3 10  7  7  4  8  7  8  6  7  5  9  4  4  6

## Note above that tVec[[3]] has 1 more c and h than tContains[[3]],
## thus tVec[[3]] is not contained in tContains[[3]]
c(tJoe[3], tGennaro[3])  
[1] FALSE FALSE           ## This is correct!!!!


table(tVec[[14]])
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 
 6  4  4  7  6  3  4  6  3  5  4  4  6  4  4  2  2  5  3  1  4 

table(tContains[[14]])
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 
 6  4 10  7  6  4 10  6  8 10  5  5  6  9  8  5  7  5 11  4  9 

## Note above that every element in tVec[[14]] is present in 
## tContains[[14]] and the number of occurences is less than or
## equal to the occurences in tContains[[14]]. Thus, tVec[[14]]
## is contained in tContains[[14]]
c(tJoe[14], tGennaro[14])
[1] TRUE TRUE            ## This is correct!!!!

Here are the benchmarks:

library(microbenchmark)
microbenchmark(Joe = mapply(is.contained, tVec, tContains),
               Gennaro = mapply(fun.contains, tContains, tVec))
Unit: milliseconds
   expr      min       lq     mean   median       uq      max neval cld
    Joe 165.0310 172.7817 181.3722 178.7014 187.0826 230.2806   100  a 
Gennaro 249.8495 265.4022 279.0866 273.5923 288.1159 336.8464   100   b

Side Note about VectorIntersect()
After spending a good bit of time with this problem, it became increasingly clear that separating VectorIntersect from is.contained is tremendously valuable. I know many times in my own work, obtaining the intersection without duplicates being removed surfaced frequently. Oftentimes, the method implemented was messy and probably not reliable (easy to see why after this!). This is why VectorIntersect is a great utility function in additon to is.contained.


Update

Actually @Gennaro's solution can be improved quite a bit by calculating s[duplicated(s)] only one time as opposed to 3 times (similarly for b and length(s), we only calculate them once vs 2 times).

fun.containsFAST <- function(b, s){
    dupS <- s[duplicated(s)]; dupB <- b[duplicated(b)]
    lenS <- length(dupS)
    all(s %in% b) && lenS <= length(dupB) &&
        (if(lenS>0) fun.containsFAST(dupB,dupS) else 1)
}

microbenchmark(Joe = mapply(is.contained, tVec, tContains),
               GenFAST = mapply(fun.containsFAST, tContains, tVec),
               Gennaro = mapply(fun.contains, tContains, tVec))
Unit: milliseconds
   expr      min       lq     mean   median       uq      max neval cld
    Joe 163.3529 172.1050 182.3634 177.2324 184.9622 293.8185   100  b 
GenFAST 145.3982 157.7183 169.3290 164.7898 173.4063 277.1561   100 a  
Gennaro 243.2416 265.8270 281.1472 273.5323 284.8820 403.7249   100   c


Update 2

What about testing containment for really big vectors? The function I provided is not likely to perform well as building the "intersection" (with duplicates etc.) by essentially looping over the true set intersection isn't very efficient. The modified @Gennaro's function won't be fast as well, because for very large vectors with many duplicates, the function calls could get nested pretty deep. With this in mind, I built yet another containment function that is specifically built for dealing with large vectors. It utilizes vectorized base R functions, especially of note pmin.int, which returns the parallel minima of multiple vectors. The inner function myL is taken directly from the guts of the rle function in base R (although slightly modified for this specific use).

is.containedBIG <- function(v, z) { ## v and z must be sorted
    myL <- function(x) {LX <- length(x); diff(c(0L, which(x[-1L] != x[-LX]), LX))}
    sum(pmin.int(myL(v[v %in% z]), myL(z[z %in% v])))==length(v)
}

Note that on smaller exmaples is.contained and fun.containsFAST are faster (this is mostly due to the time it takes to repeatedly sort.. as you will see, if the data is sorted is.containedBIG is much faster). Observe (for thoroughness we will also show the verification of @Chirayu's function and test's its efficiency):

## we are using tVec and tContains as defined above in the original test
tChirayu <- mapply(is.containedChirayu, tVec, tContains)
tJoeBIG <- sapply(1:1000, function(x) is.containedBIG(sort(tVec[[x]]), sort(tContains[[x]])))
all(tChirayu==tJoe)  ## @Chirayu's returns correct results
[1] TRUE
all(tJoeBIG==tJoe)   ## specialized alogrithm returns correct results
[1] TRUE

microbenchmark(Joe=sapply(1:1000, function(x) is.contained(tVec[[x]], tContains[[x]])),
               JoeBIG=sapply(1:1000, function(x) is.containedBIG(sort(tVec[[x]]), sort(tContains[[x]]))),
               GenFAST=sapply(1:1000, function(x) fun.containsFAST(tContains[[x]], tVec[[x]])),
               Chirayu=sapply(1:1000, function(x) is.containedChirayu(tVec[[x]], tContains[[x]])))
Unit: milliseconds
   expr       min        lq      mean    median        uq       max neval cld
    Joe  154.6158  165.5861  176.3019  175.4786  180.1299  313.7974   100 a  
 JoeBIG  269.1460  282.9347  294.1568  289.0174  299.4687  445.5222   100  b   ## about 2x as slow as GenFAST
GenFAST  140.8219  150.5530  156.2019  155.8306  162.0420  178.7837   100 a  
Chirayu 1213.8962 1238.5666 1305.5392 1256.7044 1294.5307 2619.5370   100   c  ## about 8x as slow as GenFAST

Now, with sorted data, the results are quite astonishing. is.containedBIG shows a 3 fold improvement in speed whereas the other functions return almost identical timings.

## with pre-sorted data
tVecSort <- lapply(tVec, sort)
tContainsSort <- lapply(tContains, sort)
microbenchmark(Joe=sapply(1:1000, function(x) is.contained(tVecSort[[x]], tContainsSort[[x]])),
               JoeBIG=sapply(1:1000, function(x) is.containedBIG(tVecSort[[x]], tContainsSort[[x]])),
               GenFAST=sapply(1:1000, function(x) fun.containsFAST(tContainsSort[[x]], tVecSort[[x]])),
               Chirayu=sapply(1:1000, function(x) is.containedChirayu(tVecSort[[x]], tContainsSort[[x]])))
Unit: milliseconds
   expr        min         lq       mean     median         uq       max neval  cld
    Joe  154.74771  166.46926  173.45399  172.92374  177.09029  297.7758   100   c 
 JoeBIG   83.69259   87.35881   94.48476   92.07183   98.37235  221.6014   100 a  ## now it's the fastest
GenFAST  139.19631  151.23654  159.18670  157.05911  162.85636  275.7158   100  b  
Chirayu 1194.15362 1241.38823 1280.10058 1260.09439 1297.44847 1454.9805   100    d

For very large vectors, we have the following (only showing GenFAST and JoeBIG as the other functions will take too long):

set.seed(97)
randS <- sample(10^9, 8.5*10^5)
testBigNum <- sample(randS, 2*10^7, replace = TRUE)
tVecBigNum <- lapply(1:20, function(x) {
    sample(randS, sample(1500000:2500000, 1), replace=TRUE)
})

system.time(tJoeBigNum <- sapply(1:20, function(x) is.containedBIG(sort(tVecBigNum[[x]]), sort(testBigNum))))
   user  system elapsed 
 74.016  11.351  85.409 
system.time(tGennaroBigNum <- sapply(1:20, function(x) fun.containsFAST(testBigNum, tVecBigNum[[x]])))
   user  system elapsed 
662.875  54.238 720.433
sum(tJoeBigNum)
[1] 13
all(tJoeBigNum==tGennaroBigNum)
[1] TRUE

## pre-sorted data
testBigSort <- sort(testBigNum)
tVecBigSort <- lapply(tVecBigNum, sort)
system.time(tJoeBigSort <- sapply(1:20, function(x) is.containedBIG(tVecBigSort[[x]], testBigSort)))
   user  system elapsed 
 33.910  10.302  44.289
system.time(tGennaroBigSort <- sapply(1:20, function(x) fun.containsFAST(testBigSort, tVecBigSort[[x]])))
   user  system elapsed 
196.546  54.923 258.079
identical(tJoeBigSort, tGennaroBigSort, tJoeBigNum)
[1] TRUE

Regardless if your data is sorted or not, the point of this last test is to show that is.containedBIG is much faster on larger data. An interesting take away from this last test was the fact that fun.containsFAST showed a very large improvement in time when the data was sorted. I was under the impression that duplicated (which is the workhorse of fun.containsFAST), did not depend on whether a vector was sorted or not. Earlier test confirmed this sentiment (the unsorted test timings were practically identical to the sorted test timings (see above)). More research is needed.

5
  • The above only works for vectors whose elements are numbers though, doesn't it?
    – gented
    Sep 6, 2016 at 16:01
  • Thank you for all your effort! I've maybe found a recursive method to do the same, with fewer lines of code (see my answer above). I haven't checked its benchmarks though.
    – gented
    Sep 7, 2016 at 0:12
  • True that the capabilities of base R are somewhat insufficient: I still find it very odd that basic operations need so much effort (and I still find it hard to believe that there is no in-built method for that).
    – gented
    Sep 7, 2016 at 22:35
  • I must say I still don't understand how your test work: you should show examples of lists where they fail so that one can understand what it is that needs correction.
    – gented
    Dec 24, 2016 at 10:42
  • @GennaroTedesco, I agree.. the original test were lacking in explanation. I have completely revamped my solution. Also, I was incorrectly testing your function before and I'm super sorry for this. It was an honest mistake as simply flipping the arguments gave decent enough results for me not to question. Please forgive me! Dec 24, 2016 at 18:05
1

How about a recursive method checking for length of the duplicates for each list?

fun.contains <- function(b, s){
  all(s %in% b) && length(s[duplicated(s)]) <= length(b[duplicated(b)]) &&
    (if(length(s[duplicated(s)])>0) fun.contains(b[duplicated(b)],s[duplicated(s)]) else 1 )
}

The idea is that a list is contained into another one if and only if so is the list of the respective duplicates, unless there are no duplicates (in that case the recursion defaults to TRUE).

1
  • This is a great algorithm! Its efficiency can be improved by eliminating repetitive calls. Check out the update to my answer. Dec 26, 2016 at 2:55
0

Another custom-function version, checking whether the number of elements (length()) of the non-equal elements (setdiff) is equal to the difference in the vectors' length:

# Does vector x contain vector y?
is.contained <- function(x, y) {
  z <- x[x %in%setdiff(x, y)]
  length(z) == length(x) - length(y)
}

r <- c(1,1)
s <- c(1,1,5)
t <- c(1,2,5)

is.contained(r, t)
#> [1] FALSE
is.contained(s, r)
#> [1] TRUE
is.contained(r, s)
#> [1] FALSE
4
  • r <- c(1,1); t <- c(1,1,5); is.contained(r,t) gives FALSE instead of TRUE. I think this may be a trivial solution to the example that doesn't generalize (?).
    – Hack-R
    Sep 5, 2016 at 23:17
  • It should be is.contained(t,r) (swapping the arguments, according to how the function is defined, or swapping x --> y in the return statement).
    – gented
    Sep 5, 2016 at 23:33
  • 2
    There is actually an error in the above: for t <- c(1,1,5), s <- c(2,5) the function returns TRUE whilst it should return FALSE. Still due to the fact that the cardinality of the setdiff is counted as 1.
    – gented
    Sep 6, 2016 at 20:53
  • Thanks @GennaroTedesco, well spotted. I've updated the function to handle this issue. You can condense to 1 line, but I've made 2 for clarity. By getting bigger, however, I wonder whether there's still a simpler solution. Sep 6, 2016 at 21:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.