从数字1到20生成10万个大小为3的样本，不需要替换。

Question

我试图在没有替换的情况下，从数字1到20生成大约100000个大小为3的示例，并在R中使用以下代码：

s <- sample(N,3,pi<-n*x/sum(x),replace=FALSE)
[1] 12  6 17

这给了我一个3码的样本，但是我如何生成100,000个样本呢？我们还用了

N<-20 #size of the population we could choose from
n<- 3
x <- runif(N)
pi<-n*x/sum(x)

但我不知道出了什么问题。如有任何建议，将不胜感激，谢谢。

Answer 1

我们可以通过循环遍历一个序列来使用lapply

N1 <- seq_len(100000)
N <- 20
lapply(N1, function(i) sample(N, size =3, replace=FALSE))  

Answer 2

你的问题激发了我的灵感，我试图写一个多采样-不替换的实现使用递归的抽样-有替换。

让NS代表所需样本的数量，并让NE表示要为每个示例从输入集中选择的元素数，我的想法是，尝试避免遍历NS sample()调用是有益的，这对于大型NS来说很费时。相反，我们可以从使用替换的NS值开始运行单个示例调用，并考虑这表示每个示例的“第一选择”。然后，对于每一个唯一的选择，我们可以减少输入集(和概率加权向量)被选择的元素，并递归，直到我们已经达到NE水平。通过组合每个(子)样本，我们可以生成一个矩阵，它的每个行将由一个样本组成，而不需要从输入集替换NE值。

samplesNoReplace <- function(NS,set,NE=length(set),prob=NULL) {
    if (NE>1L) {
        inds <- sample(seq_along(set),NS,T,prob);
        uris <- split(seq_len(NS),inds);
        us <- as.integer(names(uris));
        res <- base::matrix(set[inds],NS,NE);
        for (ui in seq_along(uris)) {
            u <- us[ui];
            ris <- uris[[ui]];
            res[ris,-1L] <- samplesNoReplace(length(ris),set[-u],NE-1L,prob[-u]);
        }; ## end for
    } else {
        res <- base::matrix(sample(set,NS,T,if (length(set)==1L) NULL else prob),ncol=1L);
    }; ## end if
    res;
}; ## end samplesNoReplace()

演示：

set.seed(10L); samplesNoReplace(10L,1:5,3L,c(10,2,2,2,1));
##       [,1] [,2] [,3]
##  [1,]    1    3    2
##  [2,]    1    4    3
##  [3,]    1    2    4
##  [4,]    3    2    1
##  [5,]    1    3    2
##  [6,]    1    4    2
##  [7,]    1    4    2
##  [8,]    1    2    5
##  [9,]    3    1    2
## [10,]    1    2    5

基准测试

library(microbenchmark);

bgoldst <- function() samplesNoReplace(NS,set,NE,prob);
akrun <- function() { N1 <- seq_len(NS); N <- length(set); lapply(N1, function(i) sample(set, size =NE, replace=FALSE,prob)); };
khashaa <- function() { replicate(NS, sample(set, NE,prob=prob), simplify = FALSE); };

## OP's case (100k samples, smallish set, smaller subset)
set.seed(1L);
NS <- 1e5L; set <- 1:20; NE <- 3L; prob <- runif(length(set));

microbenchmark(times=5L,bgoldst(),akrun(),khashaa());
## Unit: milliseconds
##       expr      min        lq      mean    median        uq      max neval
##  bgoldst()  40.9888  42.69257  46.33044  46.68856  47.40488  53.8774     5
##    akrun() 547.3142 564.94249 599.96134 625.07602 631.19658 631.2774     5
##  khashaa() 501.1226 521.14871 531.50227 524.65247 549.47600 561.1116     5

## 10k samples, large set, small subset
set.seed(1L);
NS <- 1e4L; set <- 1:1000; NE <- 5L; prob <- runif(length(set));

microbenchmark(times=5L,bgoldst(),akrun(),khashaa());
## Unit: milliseconds
##       expr       min        lq      mean    median        uq       max neval
##  bgoldst() 2716.1904 2722.8242 2756.9302 2731.2763 2753.5668 2860.7935     5
##    akrun()  682.0505  688.3639  691.3169  689.6165  693.9692  702.5842     5
##  khashaa()  684.5865  689.2030  698.8313  693.0822  696.1211  731.1638     5

## 1k samples, large set, large subset
set.seed(1L);
NS <- 1e3L; set <- 1:1000; NE <- 500L; prob <- runif(length(set));

microbenchmark(times=1L,bgoldst(),akrun(),khashaa());
## Unit: milliseconds
##       expr        min         lq       mean     median         uq        max neval
##  bgoldst() 74478.4313 74478.4313 74478.4313 74478.4313 74478.4313 74478.4313     1
##    akrun()   350.7270   350.7270   350.7270   350.7270   350.7270   350.7270     1
##  khashaa()   353.2574   353.2574   353.2574   353.2574   353.2574   353.2574     1

## 1M samples, small set, necessarily small subset
set.seed(1L);
NS <- 1e6L; set <- 1:4; NE <- 4L; prob <- runif(length(set));

microbenchmark(times=5L,bgoldst(),akrun(),khashaa());
## Unit: milliseconds
##       expr       min        lq      mean    median        uq       max neval
##  bgoldst()  502.0865  519.1875  602.5631  627.6124  648.3831  715.5459     5
##    akrun() 5450.3987 5653.0774 5817.0921 5799.4497 5987.0575 6195.4771     5
##  khashaa() 5301.3673 5667.8592 5683.3805 5744.1461 5824.8801 5878.6497     5

## 10M samples, small set, necessarily small subset
set.seed(1L);
NS <- 1e7L; set <- 1:4; NE <- 4L; prob <- runif(length(set));

microbenchmark(times=1L,bgoldst(),akrun(),khashaa());
## Unit: seconds
##       expr       min        lq      mean    median        uq       max neval
##  bgoldst()  5.023389  5.023389  5.023389  5.023389  5.023389  5.023389     1
##    akrun() 75.891354 75.891354 75.891354 75.891354 75.891354 75.891354     1
##  khashaa() 69.422056 69.422056 69.422056 69.422056 69.422056 69.422056     1

这一模式非常有趣，我认为，很容易解释。对于许多样本、小集合和小子集，我的函数的性能都优于它们，因为只需要很少的递归就可以覆盖所有可能的(子)样本分支，而循环解决方案必须对每个样本进行迭代和sample()调用。但是，对于较少的样本、大集合和大子集，我的函数性能严重不足，因为循环解决方案没有太多的迭代要完成，并且(子)样本分支的树随着每一个新的选择都以指数级增长。因此，我的函数只适用于许多示例、小集合和小子集的情况，顺便说一句，它们非常准确地描述了您的示例用例。

当然，即使对他们最不利的时间，循环解决方案仍然执行体面，在大约一个数量级的我的功能。此外，在任何情况下都不可能需要一个小集合的一个小子集的数百万个样本。因此，为了简单起见，我不认为完全忽略这个解决方案并始终使用循环方法是不合理的。

Answer 3

我已经尝试过复制命令和1 1apply，它们都给了我10万个大小为1到20的样本，这是很好的，但是现在我希望能够计算每个数字出现的频率。例如，我知道9可能会出现100,000次，在所有的10万个样本中，但更有可能的是，它可能会出现在大约20%的时间里。所以，如果我有10万个样本，每次3位数，那么所有数字的总数应该是30万，因为为了论证，R给了我10万个9，每个样本中正好有9个，那么还有二十万个位置留给所有其他的数字。我将函数称为s，并尝试了count1 <- length(其中(s == 2))；count1，但是这个错误(s == 1)：(list)对象不能被强制输入'double'，但我不明白这意味着什么。我如何要求R给我一个所有的数字，所有的2，等等，其中我假设他们的总数应该达到30万，因为我们结束了三十万个数字运行。谢谢。克里斯·莉莉。