Expand a numeric vector by values

Viewed 158

Here I have a numeric vector and I would like to add val_to_add to each element and append those extra values in sample_vec, with a ceiling (max_val).

set.seed(53)

max_val = 50
val_to_add = 2

sample_vec <- sort(sample(1:max_val, 8))
[1]  3  5  6 15 29 30 35 50

For example, I want to add 2 to each element in sample_vec, so for the first element, it should be 3:(3 + 2), which is 3 4 5.

Duplicated values should be discarded and the maximum value in this case should be 50. The desired output is something like this:

[1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

Here's my current code:

out_vec <- unique(c(sapply(sample_vec, function(x) sequence(val_to_add + 1, from = x))))
out_vec[out_vec <= max_val]

[1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

Is there any existing function for this kind of operation maybe in base R?

4 Answers

Make a sequence of 0 to value to add, loop, and add +:

s <- sort(unique(unlist(lapply(0:val_to_add, function(i) sample_vec + i))))
s[ s <= max_val ]
#  [1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

Another option, sapply instead of lapply (thanks Benson):

s <- unique(sort(sapply(0:val_to_add, function(i) sample_vec + i)))
s[ s <= max_val ]

Use mapply and seq to create the sequences, unravel that into a plain vector using c, take the minimum of that and max_val and then take unique elements.

unique(pmin(c(mapply(seq, sample_vec, sample_vec + val_to_add)), max_val))
## [1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

or use sapply:

sample_vec |>
  sapply(seq, length = val_to_add + 1) |>
  c() |>
  pmin(max_val) |>
  unique()
##  [1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

or outer:

sample_vec |>
  outer(X = seq(0, length = val_to_add + 1), FUN = `+`) |>
  c() |>
  pmin(max_val) |>
  unique()
##  [1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

Note

max_val <- 50
val_to_add <- 2
sample_vec <- c(3, 5, 6, 15, 29, 30, 35, 50)

Another option with sequence:

s = sequence(rep(val_to_add + 1, length(sample_vec)), sample_vec)
unique(s[s <= max_val])
#  [1]  3  4  5  6  7  8 15 16 17 29 30 31 32 35 36 37 50

data

max_val = 100000
val_to_add = 100
sample_vec <- sort(sample(1:max_val, 1000))

microbenchmark

microbenchmark::microbenchmark(
  mael = {
    s = sequence(rep(val_to_add + 1, length(sample_vec)), sample_vec)
    unique(s[s <= max_val])
  },
  zx_lapply = {
    s <- sort(unique(unlist(lapply(0:val_to_add, function(i) sample_vec + i))))
    s[ s <= max_val ]
  }, 
  zx_sapply = {
    s <- unique(sort(sapply(0:val_to_add, function(i) sample_vec + i)))
    s[ s <= max_val ]
  },
  grot_mapply = {
    unique(pmin(c(mapply(seq, sample_vec, sample_vec + val_to_add)), max_val))
  },
  grot_sapply = {
    sample_vec |>
      sapply(seq, length = val_to_add + 1) |>
      c() |>
      pmin(max_val) |>
      unique()
  },
  grot_outer = {
    sample_vec |>
      outer(X = seq(0, length = val_to_add + 1), FUN = `+`) |>
      c() |>
      pmin(max_val) |>
      unique()
  },
  bens = {
    out_vec <- unique(c(sapply(sample_vec, function(x) sequence(val_to_add + 1, from = x))))
    out_vec[out_vec <= max_val]
  },
  check = "equal")
    
Unit: milliseconds
        expr    min      lq      mean  median      uq      max neval  cld
        mael 5.4458 5.47895  5.704599 5.60350 5.90880   6.5259   100  bc 
   zx_lapply 7.0270 7.11250  7.363226 7.29015 7.60025   7.9951   100   cd
   zx_sapply 1.3772 1.42860  1.641764 1.46580 1.84930   2.6103   100 a   
 grot_mapply 5.9197 6.10410  7.600980 6.25440 6.73615 119.2962   100   cd
 grot_sapply 8.2296 8.49875 10.111101 8.64015 9.02135 127.2328   100    d
  grot_outer 2.3588 2.40995  2.673963 2.49130 2.96700   3.3915   100 ab  
        bens 7.8925 8.06655  9.526152 8.16770 8.58205 121.5818   100    d
Related