有放回地重复采样，直到超过阈值

Question

我有一个包含 2 个变量的数据集：一个 ID 和一个数量。我想对记录进行抽样（替换），直到抽样的金额总和超过原始金额总和。

我有可用的示例代码，但有更好的方法吗？我想最终运行在大型数据集上进行 100K 次迭代，但我的方法看起来很笨拙。

在下面的代码中，我只是运行进行了 3 次迭代。

set.seed(7777)

df <- data.frame(ID = seq(1,5),
                 AMT = sample(1:100, 5, replace = T))

threshold <- sum(df$AMT)

output <- NULL
for (i in 1:3) {
  repeat{
    sel <- df[sample(nrow(df), size = 1),]
    sel <- cbind(iter=i, sel)
    output <- rbind(output,
                    sel)
    check_sum <- subset(output, iter == i)
    if(sum(check_sum$AMT) > threshold) break
  }
}

Answer 1

您可以使用递归（调用自身的函数）。另外，您不需要存储所有采样结果（这里我们只存储行号）。

set.seed(7777)
df <- data.frame(ID = 1:5,AMT = sample(1:100, 5, TRUE))
threshold <- sum(df$AMT)
# Specify N not to call it multiple times
N <- nrow(df)

repeatUntilSum <- function(input = NULL) {
    # Sample one row number and join with input
    result <- c(sample(N, 1), input)
    # Check if still too low 
    if (sum(df$AMT[result]) <= threshold) {
        # Run function again
        repeatUntilSum(result)
    } else {
        # Return full sampled result
        return(df[result, ])
    }
}

到运行采样 n 次使用 lapply（returns 可以使用 data.table::rbindlist 轻松加入的列表）。

data.table::rbindlist(lapply(1:3, repeatUntilSum), idcol = "iter")

有放回地重复采样，直到超过阈值

Repeat sampling with replacement until exceeding threshold

r

sampling