是否可以在r中使用base::sample函数进行矢量化采样?

5hcedyr0  于 2023-09-27  发布在  其他
关注(0)|答案(2)|浏览(122)

我试着用lapply抽取了25个样本

a = list(c(1:5),c(100:105),c(110:115),c(57:62),c(27:32))

lapply(a,function(x)sample(x,5))

是否可以使用base::sample进行矢量化采样?

sample(c(5,5),a)
7rfyedvj

7rfyedvj1#

不可能使用base::sample;然而,通过使用runif,这种矢量化采样是可能的。
我没有一个很好的方法来矢量化采样,而不替换x中每个向量的任意数量的样本。但是我们可以对每个向量的每个元素进行采样。
下面是一个函数,它对一系列向量进行向量化采样。它将返回一个样本向量:

multisample <- function(x, n = lengths(x), replace = FALSE) {
  if (replace) {
    unlist(x)[rep.int(lengths(x), n)*runif(sum(n)) + 1 + rep.int(c(0, cumsum(lengths(x[-length(x)]))), n)]
  } else {
    unlist(x)[rank(runif(sum(n)) + rep.int(seq_along(x), n))]
  }
}

使用lapply的等效函数:

multisample2 <- function(x, n = lengths(x), replace = FALSE) {
  unlist(lapply(seq_along(n), function(i) sample(x[[i]], n[i], replace)))
}

示例用法:

x <- list(c(1:9), c(11:18), c(21:27), c(31:36), c(41:45))

# sampling without replacement
multisample(x)
#>  [1]  9  3  5  8  7  2  1  4  6 18 11 17 12 16 14 13 15 22 26 25 21 27 24 23 36
#> [26] 31 35 34 33 32 45 43 42 44 41
multisample2(x)
#>  [1]  3  6  7  9  2  1  8  4  5 17 16 11 15 14 13 12 18 23 22 26 21 27 24 25 33
#> [26] 32 35 34 31 36 42 43 41 44 45

# sampling with replacement
n <- 7:3 # the number of samples from each vector
multisample(x, n, 1)
#>  [1]  9  8  5  9  3  5  3 12 18 12 17 12 16 26 26 24 26 27 33 33 35 32 44 44 43
multisample2(x, n, 1)
#>  [1]  9  8  3  7  8  7  8 15 14 15 16 18 14 27 27 21 27 27 33 36 33 34 45 44 41

矢量化版本的速度要快得多:

x <- lapply(sample(10:15, 1e4, 1), seq)
n <- sample(10, 1e4, 1)

microbenchmark::microbenchmark(multisample = multisample(x),
                               multisample2 = multisample2(x))
#> Unit: milliseconds
#>          expr       min       lq     mean   median      uq      max neval
#>   multisample  9.116301 10.33815 11.05857 10.70595 11.2395  16.9397   100
#>  multisample2 62.319401 67.38040 71.06072 69.72585 72.4703 127.0234   100
microbenchmark::microbenchmark(multisample = multisample(x, n, 1),
                               multisample2 = multisample2(x, n, 1))
#> Unit: milliseconds
#>          expr       min       lq      mean    median        uq        max neval
#>   multisample  2.535401  2.93265  3.167103  3.130601  3.420651   4.254302   100
#>  multisample2 56.220200 61.74615 65.638942 65.007451 67.325051 109.572501   100

如果需要矢量列表,则可以修改函数:

multisample <- function(x, n = lengths(x), replace = FALSE) {
  i <- rep.int(seq_along(x), n)
  if (replace) {
    split(unlist(x)[rep.int(lengths(x), n)*runif(sum(n)) + 1 + rep.int(c(0, cumsum(lengths(x[-length(x)]))), n)], i)
  } else {
    split(unlist(x)[rank(runif(sum(lengths(x))) + i)], i)
  }
}

multisample2 <- function(x, n = lengths(x), replace = FALSE) {
  if (replace) {
    lapply(seq_along(n), function(i) sample(x[[i]], n[i], 1))
  } else {
    lapply(x, sample)
  }
}

矢量化的版本仍然要快得多。

omhiaaxx

omhiaaxx2#

不可以。没有选项可以使用sample()对采样向量进行分层。lapply()才是要走的路。

相关问题