CODEWITHSUNDEEP
r
Soul Donut
Soul Donut

Reputation: 382

Test if vector is contained in another vector, including repetitions

I've been struggling with this one for a while: given two vectors, each containing possible repetitions of elements, how do I test if one is perfectly contained in the other? %in% does not account for repetitions. I can't think of an elegant solution that doesn't rely on a something from the apply family.

x      <- c(1, 2, 2, 2)
values <- c(1, 1, 1, 2, 2, 3, 4, 5, 6)

# returns TRUE, but x[x == 2] is greater than values[values == 2]
all(x %in% values)

# inelegant solution
"%contains%" <- 
    function(values, x){
                   n <- intersect(x, values)
                   all( sapply(n, function(i) sum(values == i) >= sum(x == i)) )
                       }

# which yields the following:
> values %contains% x
 [1] FALSE
> values <- c(values, 2)
> values %contains% x
 [2] TRUE

Benchmarking update

I may have found another solution in addition to the answer provided by Marat below

# values and x must all be non-negative - can change the -1 below accordingly
"%contains%" <- 
    function(values, x){
            t <- Reduce(function(.x, .values) .values[-which.max(.values == .x)]
                        , x = x
                        , init = c(-1, values))
            t[1] == -1
     }

Benchmarking all the answers so far, including thelatemail's modification of marat, using both large and small x

library(microbenchmark)

set.seed(31415)
values <- sample(c(0:100), size = 100000, replace = TRUE)
set.seed(11235)
x_lrg <- sample(c(0:100), size = 1000, replace = TRUE)
x_sml <- c(1, 2, 2, 2)


lapply(list(x_sml, x_lrg), function(x){
    microbenchmark(    hoho_sapply(values, x)
                     , marat_table(values, x)
                     , marat_tlm(values, x)
                     , hoho_reduce(values, x)
                     ,  unit = "relative")
    })

 # Small x
 # [[1]]
 # Unit: relative
 #                  expr       min        lq     mean   median       uq      max neval
 # hoho_sapply(values, x)  1.000000  1.000000 1.000000 1.000000 1.000000 1.000000   100
 # marat_table(values, x) 12.718392 10.966770 7.487895 9.260099 8.648351 1.819833   100
 #   marat_tlm(values, x)  1.354452  1.181094 1.026373 1.088879 1.266939 1.029560   100
 # hoho_reduce(values, x)  2.951577  2.748087 2.069830 2.487790 2.216625 1.097648   100
 #
 # Large x
 # [[2]]
 # Unit: relative
 #                   expr       min        lq      mean    median        uq        max neval
 # hoho_sapply(values, x)  1.158303  1.172352  1.101410  1.177746  1.096661  0.6940260   100
 # marat_table(values, x)  1.000000  1.000000  1.000000  1.000000  1.000000  1.0000000   100
 #   marat_tlm(values, x)  1.099669  1.059256  1.102543  1.071960  1.072881  0.9857229   100
 # hoho_reduce(values, x) 85.666549 81.391495 69.089366 74.173366 66.943621 27.9766047   100

Upvotes: 4

Views: 2986

Answers (1)

Marat Talipov
Marat Talipov

Reputation: 13314

Try using table, e.g.:

"%contain%" <- function(values,x) {
    tx <- table(x)
    tv <- table(values)
    z <- tv[names(tx)] - tx
    all(z >= 0 & !is.na(z))
}

Some examples:

> c(1, 1, 1, 2, 2, 3, 4, 5, 6) %contain% c(1,2,2,2)
[1] FALSE
> c(1, 1, 1, 2, 2, 3, 4, 5, 6, 2) %contain% c(1,2,2,2)
[1] TRUE
> c(1, 1, 1, 2, 2, 3, 4, 5, 6) %contain% c(1,2,2)
[1] TRUE
> c(1, 1, 1, 2, 2, 3, 4, 5, 6) %contain% c(1,2,2,7)
[1] FALSE

Upvotes: 8

Related Questions