R равная выборка занимает слишком много времени

Question

Я хочу попробовать строки из разных лет, учитывая некоторые ограничения.

Скажи, что мой набор данных выглядит так:

library(data.table)
dataset = data.table(ID=sample(1:21), Vintage=c(1989:1998, 1989:1998, 1992), Region.Focus=c("Europe", "US", "Asia"))
> dataset
    ID Vintage Region.Focus
 1:  7    1989       Europe
 2: 10    1990           US
 3: 20    1991         Asia
 4: 18    1992       Europe
 5:  4    1993           US
 6: 17    1994         Asia
 7: 13    1995       Europe
 8:  9    1996           US
 9: 12    1997         Asia
10:  3    1998       Europe
11: 11    1989           US
12: 14    1990         Asia
13:  8    1991       Europe
14: 16    1992           US
15: 19    1993         Asia
16:  1    1994       Europe
17:  5    1995           US
18: 15    1996         Asia
19:  6    1997       Europe
20: 21    1998           US
21:  2    1992         Asia
    ID Vintage Region.Focus

Я хочу, чтобы 1000 розыгрышей с размерами выборки 2 и 4 (отдельно друг от друга) распространились на два года. Например, для 1000 тиражей с размером выборки 2 это может быть первый и второй ряд. У меня также есть ограничение, что образец должен состоять из строк с одинаковым фокусом области. Мое решение - код ниже, но это слишком медленно.

for(i in c(2,4)) {
  simulate <- function(i) {
    repeat{
      start <- dataset[sample(nrow(dataset), 1, replace=TRUE),]
      t <- start$Vintage:(start$Vintage + 1)
      matches <- which(dataset$Vintage %in% t & dataset$Region.Focus == start$Region.Focus) #constraints
      DT <- dataset[matches,]
      DT <- as.data.table(DT)
      x <- DT[,.SD[sample(.N,min(.N,i/length(t)))],by = Vintage]
      if(nrow(x) ==i) {
        x <- as.data.frame(x)
        x <- x %>% mutate(EqualWeight = 1 / i) %>% mutate(RandomWeight = prop.table(runif(i)))
        x <- ungroup(x)
        return(x)
      } else {
        x <- 0
      }
    }

  }
  #now replicate the expression 1000 times
  r <- replicate(1000, simulate(i), simplify=FALSE)
  r <- rbindlist(r, idcol="draw")
  f <- as.data.frame(r)
  write.csv(p, file=paste("Performance.fof.5", i, "csv", sep="."))
  fof <- paste("fof.5", i, sep = ".")
  assign(fof, f)
}

Этот код очень медленный. Моя первоначальная интуиция заключается в том, что мой подход потребует много средств и продолжает работать из-за ограничений. У меня 5800 строк.

Есть ли способ, кроме функции повтора, который приводит к большим циклам? Возможно, есть другой способ выразить линию DT[,.SD[sample(.N,min(.N,i/length(t)))],by = Vintage] избавиться от повторного выражения? Заранее благодарю за любой вклад!