Question

假设我有一张2006年在美国出生的十个最受欢迎的婴儿名字的频率图表：

myfreq <- c(24835, 22630, 22313, 21398, 20504, 20326, 20054, 19711, 19672, 19400)
names(myfreq) <- c("Jacob", "Michael", "Joshua", "Emily", "Ethan", "Matthew", "Daniel", "Andrew", "Christopher", "Anthony")

> myfreq
      Jacob     Michael      Joshua       Emily       Ethan     Matthew      Daniel 
      24835       22630       22313       21398       20504       20326       20054 
     Andrew Christopher     Anthony 
      19711       19672       19400

现在考虑一下这些名字的210,843名婴儿，2006年在美国出生。这套有2 ^ 210843个子集。我想要婴儿的随机子集的babyname频率图表，每个子集的可能性相同。我的代码如下：

subfreq <- sapply(myfreq, function(k) sum(rbinom(k, 1, 0.5)))

这是我想做的吗？是否有某种方法可以提高性能？它将在一个循环中进行数百万次迭代，并且rbinom函数似乎非常慢;我想知道在这个特殊的二项分布情况下，R中是否有更快的函数，其中p = 1/2。感谢您的帮助。

Answer 1

无法完全完成。您无法构建所有可能的子集，因此请忘记这种方法。

如果你知道一些数学，可以大约完成。

首先，您需要样本大小为n的概率，即（R）天真地：

choose(N, n)/2^N

对于中等N和n（例如N=1050和n=525），这将分解。所以你可以尝试对数，经过一些工作后得到（其中lgamma是伽马函数的对数，而n + 1处的伽马函数与n相同！）由下式给出的概率：

exp(lgamma(N+1) - lgamma(n+1) - lgamma(N-n+1) - N*log(2))

为了将所有概率都集成到一个向量中，我们可以将它包装成一个函数：

pmf <- function(N,n) {
  exp(lgamma(N+1) - lgamma(n+1) - lgamma(N-n+1) - N*log(2))
}

N <- sum(myfreq)
probs <- sapply(0:N, function(n) pmf(N,n))

请注意，大多数样本大小的概率为0（大约）。现在要选择样品，首先根据probs中的概率选择样本大小，然后从名称群中选择该大小的样本。我们需要从你给出的频率中首先获得这个数量。

mypop <- rep(mynames, myfreq)

样本本身：

sample(mypop, sample(0:N, 1, prob = probs))

复制很多次：

k <- 100
samps <- replicate(k, sample(mypop, sample(0:N, 1, prob = probs)))

samps是随机选择尺寸的样本列表。

请注意，要选择的非零概率的唯一样本大小为：

range(which(probs > 0))
#> 96603 114242

因此，您的样本的属性不会像您想象的那样有趣。他们将非常接近婴儿名字的人口分布。让婴儿开始变得更加有趣。

Answer 2

不确定你是否想要使用bootstraps来模拟绘图，但如果这是你想要的，我会尝试使用data.table的以下方法。一次抽奖：

library(data.table)

# Example data:
dat.namefreqs <- data.table(name=LETTERS, count=sample(1e4, size=26))

# Format:
name count
   A  7466
   B 10000
   C  8897
   D  6833
   E  8614
   F  8128
   G  1837
   H  9349
   I  7798
   J  1158
   K  1707
   L  3368
   M  1019
   N   795
   O  1840
   P  4476
   Q  5345
   R   247
   S  5430
   T  9879
   U  1328
   V  4530
   W  6865
   X  6693
   Y  2186
   Z  1754

# Total all individuals
N.tot <- sum(dat.namefreqs$count)

# Repeat each name * its frequency
dat.expanded <- dat.namefreqs[rep(1:.N, count)]

# For a single random draw,
# Create a vector of binomial draws of 1s and 0s from rbinom, size = N.tot
# Use that as a true/false vector to extract names, and aggregate counts by name

dat.expanded[which(rbinom(N.tot, 1, 0.5)==1)][, .N, by=name]

单次抽奖的示例输出：

    name    N
 1:    A 1339
 2:    B 1851
 3:    C 2898
 4:    D 4548
 5:    E 1066
 6:    F 4421
 7:    G 4754
 8:    H 3337
 9:    I 3144
10:    J  286
11:    K 1065
12:    L  880
13:    M 3435
14:    N 1942
15:    O 3851
16:    P 2471
17:    Q 3549
18:    R 4933
19:    S 1911
20:    T 3799
21:    U 4632
22:    V 1092
23:    W 3229
24:    X  631
25:    Y 1321
26:    Z 1883

并且通过foreach重复引导：我的机器在一个核心上在17秒内运行〜1000次自举，上面有一个表（136654行，比你的大一半多一点）

library(foreach)

dat.namefreqs <- data.table(name=LETTERS, count=sample(1e4, size=26))

N.tot <- sum(dat.namefreqs$count)

dat.expanded <- dat.namefreqs[rep(1:.N, count)]

results <- foreach(n=1:1000, .combine="rbind") %do% {
    dat <- dat.expanded[which(rbinom(N.tot, 1, 0.5)==1)][, .N, by=name]
    dat[, bootstrap := n]
    return(dat[])
}

> results
       name    N bootstrap
    1:    A 1339         1
    2:    B 1851         1
    3:    C 2898         1
    4:    D 4548         1
    5:    E 1066         1
   ---
25996:    V 1055      1000
25997:    W 3234      1000
25998:    X  636      1000
25999:    Y 1315      1000
26000:    Z 1895      1000

R

2 个答案: