按值扩展数值向量

Expand a numeric vector by values

这里我有一个数字向量,我想将 val_to_add 添加到每个元素并将这些额外值附加到 sample_vec 中,并带有上限 (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

比如我要给sample_vec中的每个元素加上2,那么第一个元素应该是3:(3 + 2),也就是3 4 5

应丢弃重复值,本例中的最大值应为 50。所需的输出是这样的:

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

这是我当前的代码:

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

在 R 基类中是否存在用于此类操作的函数?

使用 mapply 和 seq 创建序列,使用 c 将其分解为一个普通向量,取最小值和 max_val,然后取唯一元素。

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

或使用 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

或外部:

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

备注

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

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

制作一个0到值的序列进行加法,循环,加法+:

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

另一种选择,应用而不是lapply(感谢Benson):

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

数据

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

微基准测试

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