R - 抽取固定概率的随机样本

R - Drawing a random sample with fixed probabilities

我正在尝试在 R 中编写一个循环,以根据原始数据集的随机抽样创建 200 个数据帧。我希望用 10% 男性(编码为 1)和 90% 女性(编码为 0)的固定比例替换抽取样本 - 变量 SEX - 以及与原始数据集相同的行数。

这是我得到的结果:

for (i in 1:200) {

 smpl[i] <- data[sample(nrow(data), nrow(data), replace=T, prob=ifelse(data$SEX==1,0.1,0.9)),] 

}

不幸的是,该代码不起作用...

首先抽取样本的代码没有保持男女比例为0.1:0.9

其次,当我尝试循环执行命令时,我收到一条错误消息:

警告 [<-.data.frame(*tmp*, i, value = list(ID = c(32604L, 11645L, : 提供了 41 个变量来替换 1 个变量

有人能帮忙吗?

首先,一些示例数据:

## Sample data
nMen <- 50
nWomen <- 60

set.seed(124)

mydata <- data.frame(SEX = rep(c("female", "male"), times = c(nWomen, nMen)),
    myValue = rnorm(nMen + nWomen), ID = seq_len(nMen + nWomen))

然后,计算每个样本中您想要的女性和男性人数 - 这些必须是整数

## Number of women and men for the sampling
nSampW <- (nWomen + nMen) * 0.9
nSampM <- (nWomen + nMen) * 0.1
## These should be integer (the following should be TRUE)
nSampW %% 1 ==0
nSampM %% 1 ==0

然后设置您的结果向量 - 下面创建一个列表 space 用于 200 个样本

## Set up results list
mySamp <- vector(mode = "list", length = 200)

然后循环,从指标除以性别抽取上面计算的男女人数

## The loop
for(i in seq_along(mySamp)) {
## Get indices by SEX
    idxW <- which(mydata$SEX == "female")
    idxM <- which(mydata$SEX == "male")
## Sample corresponding number of rows from those indexes with replacement
    tempW <- mydata[sample(idxW, nSampW, replace = TRUE), ]
    tempM <- mydata[sample(idxM, nSampM, replace = TRUE), ]
## rbind back together and assign
    mySamp[[i]] <- rbind(tempW, tempM)
}

然后检查比例是否正确

# sapply(mySamp[1:10], function(x) prop.table(table(x$SEX)))
#        [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# female  0.9  0.9  0.9  0.9  0.9  0.9  0.9  0.9  0.9   0.9
# male    0.1  0.1  0.1  0.1  0.1  0.1  0.1  0.1  0.1   0.1

您的代码永远不会为您提供准确的 10%-90% 拆分。

这个怎么样:

ans <- list()
# sample data
data_test <- data.frame(SEX = sample(c(0,1 ), 100, replace = TRUE), val = rnorm(100))

for(i in 1 : 200){

    data_m <- data_test[data_test$SEX == 1, ]
    data_m1 <- data_m[sample(nrow(data_m), floor(nrow(data_test) * 0.1), replace = TRUE), ]

    data_f <- data_test[data_test$SEX == 0, ]
    data_f1 <- data_f[sample(nrow(data_f), floor(nrow(data_test) * 0.9), replace = TRUE), ]

    new_data <- rbind(data_f1, data_m1)
    ans[[i]] <- new_data
}