r语言 - 如何用加权抽样连接数据?



我想在两个数据集之间做一个加权连接:

library(tidyverse)
set.seed(1)
test.sample <- data.frame(zip=sample(1:3,50,replace = TRUE))
index.dat <- data.frame(zip=c(1,1,2,3,3,3),
fips=c("A1", "A2", "B", "C1", "C2","C3"),
prob=c(.75,.25,1,.7,.2,.1))

我的预期输出将是来自索引数据集的加权样本:

results1 <- c(rep("A1",14),rep("A2",4),rep("B",19,),rep("C1",9),rep("C2",3),"C3")

最终尝试将与总体概率分布中的多个提示码匹配的邮政编码连接起来。

这个评论很好地描述了我正在努力克服的问题:https://stackoverflow.com/a/13316857/4828653

这是我想到的一个潜在的解决方案,但考虑到我有数十亿条记录,我需要性能更高的东西。

test_function <- function(x) {
index.dat %>% 
filter(zip == x) %>% 
sample_n(size=1,weight=prob) %>% 
select(fips)
}
results2 <- lapply(test.sample$zip, function(x) test_function(x)) %>% 
unlist() %>% 
data.frame(fips = .)
> table(results1)
results1
A1 A2  B C1 C2 C3 
14  4 19  9  3  1 
> table(results2)
results2
A1 A2  B C1 C2 C3 
15  3 19  8  2  3 

您可以根据zip拆分index.dat,为每个单独的邮政编码提供数据帧列表。如果您使用test.sample$zip对该列表进行子集化,您将得到一个包含50个数据帧的列表,其中包含相应的邮政编码。然后,您可以使用每个数据帧的prob列中的权重对提示进行采样。

在你的例子中,它看起来像这样:

sample_space <- split(index.dat, index.dat$zip)[test.sample$zip]
test.sample$fips <- sapply(sample_space, 
function(x) sample(x$fips, 1, prob = x$prob))

现在test.sample$fips将从适当的邮政编码中选择一个随机的fip,并根据相对权重进行抽样。如果我们做一个test.sampl$fips的表,我们可以看到比例是正确的:

table(test.sample$fips)
#> A1 A2  B C1 C2 
#> 13  5 19 10  3 

zip 1的18个成员以(几乎)75:25的比例分配给A1和A2。如预期的那样,zip 2的所有成员都被指定为B,并且zip 3的13个成员已被适当地分配(尽管由于概率低,偶然没有选择c3)

如果test.sample有5000行,我们会看到,由于大数定律,比例更接近预期的权重:

#>   A1   A2    B   C1   C2   C3 
#> 1257  419 1687 1153  325  159 

最新更新