Test if vector is contained in another vector, including repetitions - r

Question

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

Answer 1

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