Повторите отбор проб с заменой до превышения порога - PullRequest
Новая
       6

Повторите отбор проб с заменой до превышения порога

0 голосов
/ 15 января 2019

У меня есть набор данных с 2 переменными: идентификатор и сумма. Я хочу сделать выборку записей (с заменой), пока сумма выборочных сумм не превысит первоначальную сумму.

У меня есть пример кода, который работает, но есть ли лучший способ? В конечном итоге я хочу выполнить 100 000 итераций для большого набора данных, и мой метод выглядит неуклюжим.

В приведенном ниже коде я просто выполняю 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
  }
}

1 Ответ

0 голосов
/ 15 января 2019

Вы можете использовать рекурсию (функция, которая сама себя вызывает). Кроме того, вам не нужно хранить все результаты выборки (здесь мы храним только номера строк). 

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 (возвращает список, который можно легко объединить с помощью data.table::rbindlist). 

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