Заблокировать bootstrap из списка тем

вы также можете использовать tsboot

Я нашел метод, используя dplyr::left_join это немного более лаконично, занимает около 60% времени и дает те же результаты, что и в ответе Шона. Вот самодостаточный пример.

library(boot)  # for boot
library(plm)   # for Grunfeld
library(dplyr) # for left_join

# First get the data
data("Grunfeld", package="plm")

myfit1 <- function(x, i) {
  # x is the vector of firms
  # i are the indexes into x
  mydata <- do.call("rbind", lapply(i, function(n) subset(Grunfeld, firm==x[n])))
  coefficients(lm(value ~ inv + capital, data = mydata))
}

myfit2 <- function(x, i) {
  # x is the vector of firms
  # i are the indexes into x
  mydata <- left_join(data.frame(firm=x[i]), Grunfeld, by="firm")
  coefficients(lm(value ~ inv + capital, data = mydata))
}

# rbind method
set.seed(1)
system.time(b1 <- boot(firms, myfit1, 5000))
  ##  user  system elapsed 
  ## 13.51    0.01   13.62 

# left_join method
set.seed(1)
system.time(b2 <- boot(firms, myfit2, 5000))
   ## user  system elapsed 
   ## 8.16    0.02    8.26 

summary(b1)
##      R  original bootBias    bootSE   bootMed
## 1 5000 410.81557 14.78272 195.62461 413.70175
## 2 5000   5.75981  0.49301   2.42879   6.00692
## 3 5000  -0.61527 -0.13134   0.78854  -0.76452
summary(b2)
##      R  original bootBias    bootSE   bootMed
## 1 5000 410.81557 14.78272 195.62461 413.70175
## 2 5000   5.75981  0.49301   2.42879   6.00692
## 3 5000  -0.61527 -0.13134   0.78854  -0.76452

решение должно быть изменено для управления фиксированными эффектами.

library(boot)  # for boot
library(plm)   # for Grunfeld
library(dplyr) # for left_join

## Get the Grunfeld firm data (10 firms, each for 20 years, 1935-1954)
data("Grunfeld", package="plm")

## Create dataframe with unique firm identifier (one line per firm)
firms <- data.frame(firm=unique(Grunfeld$firm),junk=1)

## for boot(), X is the firms dataframe; i index the sampled firms
myfit <- function(X, i) {
    ## join the sampled firms to their firm-year data
    mydata <- left_join(X[i,], Grunfeld, by="firm")
    ## Distinguish between multiple resamples of the same firm
    ## Otherwise they have the same id in the fixed effects regression
    ## And trouble ensues
    mydata  <- mutate(group_by(mydata,firm,year),
                      firm_uniq4boot = paste(firm,"+",row_number())
                      )
    ## Run regression with and without firm fixed effects
    c(coefficients(lm(value ~ inv + capital, data = mydata)),
    coefficients(lm(value ~ inv + capital + factor(firm_uniq4boot), data = mydata)))
    }

set.seed(1)
system.time(b <- boot(firms, myfit, 1000))

summary(b)

summary(lm(value ~ inv + capital, data=Grunfeld))
summary(lm(value ~ inv + capital + factor(firm), data=Grunfeld))

вот метод, который обычно должен быть быстрее принятого ответа, возвращает те же результаты и не полагается на дополнительные пакеты (кроме boot). Ключ здесь-использовать which и целочисленных индексирование для построения каждого данных.кадр реплицировать, а не split/subset и do.call/rbind.

# get function for boot
myIndex <- function(x, i) {
  # select the observations to subset. Likely repeated observations
  blockObs <- unlist(lapply(i, function(n) which(x[n] == Grunfeld$firm)))
  # run regression for given replicate, return estimated coefficients
  coefficients(lm(value~ inv + capital, data=Grunfeld[blockObs,]))
}

Итак, загрузочный

# get result
library(boot)
set.seed(1234)
b1 <- boot(firms, myIndex, 200)

"выполнить" принято отвечать

set.seed(1234)
b0 <- boot(firms, myfit, 200)

давайте зрачка сравнение

используя индексации

b1

ORDINARY NONPARAMETRIC BOOTSTRAP


Call:
boot(data = firms, statistic = myIndex, R = 200)


Bootstrap Statistics :
       original      bias    std. error
t1* 410.8155650 -6.64885086 197.3147581
t2*   5.7598070  0.37922066   2.4966872
t3*  -0.6152727 -0.04468225   0.8351341

оригинальные версии

b0

ORDINARY NONPARAMETRIC BOOTSTRAP


Call:
boot(data = firms, statistic = myfit, R = 200)


Bootstrap Statistics :
       original      bias    std. error
t1* 410.8155650 -6.64885086 197.3147581
t2*   5.7598070  0.37922066   2.4966872
t3*  -0.6152727 -0.04468225   0.8351341

они выглядят довольно близко. Теперь, немного больше проверки

identical(b0$t, b1$t)
[1] TRUE

и

identical(summary(b0), summary(b1))
[1] TRUE

наконец, мы сделаем быстрый тест

library(microbenchmark)
microbenchmark(index={b1 <- boot(firms, myIndex, 200)}, 
              rbind={b0 <- boot(firms, myfit, 200)})

на моем компьютере, это возвращает

Unit: milliseconds
  expr      min       lq     mean   median       uq      max neval
 index 292.5770 296.3426 303.5444 298.4836 301.1119 395.1866   100
 rbind 712.1616 720.0428 729.6644 724.0777 731.0697 833.5759   100

таким образом, прямое индексирование более чем в 2 раза быстрее на каждом уровне распределения.

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