Estoy produciendo un script para crear muestras de bootstrap del catsconjunto de datos (del -MASS-paquete).

Siguiendo el libro de texto de Davidson y Hinkley [1], realicé una regresión lineal simple y adopté un procedimiento no paramétrico fundamental para el arranque de las observaciones de iid, a saber, el remuestreo de pares .

La muestra original tiene la forma:

Bwt   Hwt

2.0   7.0
2.1   7.2

...

1.9    6.8

A través de un modelo lineal univariante, queremos explicar el peso del hogar de los gatos a través de su peso cerebral.

El codigo es:

library(MASS)
library(boot)


##################
#   CATS MODEL   #
##################

cats.lm <- glm(Hwt ~ Bwt, data=cats)
cats.diag <- glm.diag.plots(cats.lm, ret=T)


#######################
#   CASE resampling   #
#######################

cats.fit <- function(data) coef(glm(data$Hwt ~ data$Bwt)) 
statistic.coef <- function(data, i) cats.fit(data[i,]) 

bootl <- boot(data=cats, statistic=statistic.coef, R=999)

Supongamos ahora que existe una variable de agrupación cluster = 1, 2,..., 24(por ejemplo, cada gato pertenece a una camada determinada). Para simplificar, suponga que los datos están equilibrados: tenemos 6 observaciones para cada grupo. Por lo tanto, cada una de las 24 camadas se compone de 6 gatos (es decir, n_cluster = 6y n = 144).

Es posible crear una clustervariable falsa a través de:

q <- rep(1:24, times=6)
cluster <- sample(q)
c.data <- cbind(cats, cluster)

Tengo dos preguntas relacionadas:

¿Cómo simular muestras de acuerdo con la estructura del conjunto de datos (agrupados)? Es decir, ¿cómo volver a muestrear a nivel de clúster? Me gustaría muestrear los grupos con reemplazo y establecer las observaciones dentro de cada grupo seleccionado como en el conjunto de datos original (es decir, tomar muestras con el reemplazo de los grupos y sin reemplazar las observaciones dentro de cada grupo).

Esta es la estrategia propuesta por Davidson (p. 100). Supongamos que sacamos B = 100muestras. Cada uno de ellos debe estar compuesto por 24 grupos posiblemente recurrentes (por ejemplo cluster = 3, 3, 1, 4, 12, 11, 12, 5, 6, 8, 17, 19, 10, 9, 7, 7, 16, 18, 24, 23, 11, 15, 20, 1), y cada grupo debe contener las mismas 6 observaciones del conjunto de datos original. ¿Cómo hacer eso en R? (ya sea con o sin el -boot-paquete). ¿Tiene sugerencias alternativas para continuar?

La segunda pregunta se refiere al modelo de regresión inicial. Supongamos que adopto un modelo de efectos fijos , con intersecciones a nivel de clúster. ¿Cambia el procedimiento de remuestreo adoptado?

[1] Davidson, AC, Hinkley, DV (1997). Métodos Bootstrap y sus aplicaciones . Prensa de la Universidad de Cambridge.

El remuestreo de los grupos completos se conoce en las estadísticas de encuestas desde que se ha utilizado cualquier método de remuestreo (es decir, desde mediados de la década de 1960), por lo que es un método bien establecido. Vea mi colección de enlaces en http://www.citeulike.org/user/ctacmo/tag/survey_resampling . Si bootpuede hacer esto o no, no lo sé; Uso el surveypaquete cuando necesito trabajar con bootstraps de encuestas, aunque la última vez que lo revisé no tenía toda la funcionalidad que necesitaba (como algunas correcciones de muestra pequeñas, por lo que puedo recordar).

No creo que la aplicación de un modelo en particular, como los efectos fijos, cambie mucho las cosas, pero, en mi opinión, el bootstrap residual hace muchas suposiciones fuertes (los residuos son iid, el modelo está correctamente especificado). Cada uno de ellos se rompe fácilmente, y la estructura del clúster seguramente rompe la suposición de iid.

Ha habido algo de literatura econométrica sobre arranque de clúster salvaje. Fingieron que trabajaron en el vacío sin todos esos cincuenta años de encuestas de investigación de estadísticas sobre el tema, por lo que no estoy seguro de qué hacer con él.

Traté de resolver el problema yo mismo, y produje el siguiente código.

Aunque funciona, probablemente podría mejorarse en términos de velocidad. Además, si fuera posible, hubiera preferido encontrar una manera de usar el -boot-paquete, ya que permite calcular automáticamente una serie de intervalos de confianza de arranque a través de boot.ci...

Para simplificar, el conjunto de datos inicial consiste en 18 gatos (las observaciones de "nivel inferior") anidados en 6 laboratorios (la variable de agrupamiento). El conjunto de datos está equilibrado ( n_cluster = 3para cada grupo). Tenemos un regresor x, para explicar y.

El conjunto de datos falso y la matriz donde almacenar los resultados son:

  # fake sample 
  dat <- expand.grid(cat=factor(1:3), lab=factor(1:6))
  dat <- cbind(dat, x=runif(18), y=runif(18, 2, 5))

  # empty matrix for storing coefficients estimates and standard errors of x
  B <- 50 # number of bootstrap samples
  b.sample <- matrix(nrow=B, ncol=3, dimnames=list(c(), c("sim", "b_x", "se_x")))
  b.sample[,1] <- rep(1:B)

En cada una de las Biteraciones, el siguiente ciclo muestra 6 grupos con reemplazo, cada uno compuesto por 3 gatos muestreados sin reemplazo (es decir, la composición interna de los grupos se mantiene inalterada). Las estimaciones del coeficiente regresor y de su error estándar se almacenan en la matriz creada previamente:

  ####################################
  #   loop through "b.sample" rows   #
  ####################################

  for (i in seq(1:B)) {

  ###   sampling with replacement from the clustering variable   

    # sampling with replacement from "cluster" 
    cls <- sample(unique(dat$lab), replace=TRUE)
    cls.col <- data.frame(lab=cls)

    # reconstructing the overall simulated sample
    cls.resample <- merge(cls.col, dat, by="lab")


  ###   fitting linear model to simulated data    

    # model fit
    mod.fit <- function(data) glm(data$y ~ data$x)

    # estimated coefficients and standard errors
    b_x <- summary(mod.fit(data=cls.resample))$coefficients[2,1]
    	se_x <- summary(mod.fit(data=cls.resample))$coefficients[2,2]

    b.sample[i,2] <- b_x
    b.sample[i,3] <- se_x

  }

Espero que esto ayude, Lando

Aquí hay una manera mucho más simple (y casi indudablemente más rápida) de hacer el arranque utilizando data.table(en los datos de @ lando.carlissian):

library(data.table)
setDT(dat, key = "lab")
b.sample <- 
  replicate(B, dat[.(sample(unique(lab), replace = T)),
                   glm(y ~ x)$coefficients])

Tuve que hacer esto recientemente y lo usé dplyr. La solución no es tan elegante como con data.table, pero:

library(dplyr)
replicate(B, {
  cluster_sample <- data.frame(cluster = sample(dat$cluster, replace = TRUE))
  dat_sample <- dat %>% inner_join(cluster_sample, by = 'cluster')
  coef(lm(y ~ x, data = dat_sample))
})

El inner_joinrepite cada fila que tiene un valor dado xde clusterpor el número de veces que xaparece en cluster_sample.

Hola, una solución muy simple basada en split y lapply, no necesita un paquete específico, excepto "boot", por ejemplo, con una estimación de ICC basada en el procedimiento nagakawa:

# FIRST FUNCTION : "parameter assesment"
nagakawa <- function(dataICC){
    #dataICC <- dbICC
    modele <- lmer(indicateur.L ~ 1 + (1|sujet.L) + (1|injection.L) + experience.L, data = dataICC)
    variance <- get_variance(modele)
    var.fixed <- variance$var.fixed
var.random <- variance$var.random
    var.sujet <- variance$var.intercept[1]
var.resid <- variance$var.residual
    icc.juge1 <- var.random / (var.random + var.fixed + var.resid)

    modele <- lmer(indicateur.L ~ 1 + (1 + injection.L|sujet.L) + experience.L, data = dataICC)
    variance <- VarCorr(modele)
    var.fixed <- get_variance_fixed(modele)
    var.random <- (attributes(variance$sujet.L)$stddev[1])^2 + (attributes(variance$sujet.L)$stddev[2])^2
    var.sujet <- (attributes(variance$sujet.L)$stddev[1])^2
    var.resid <- (attributes(variance)$sc)^2
icc.juge2 <- var.random / (var.random + var.fixed + var.resid)
return(c(as.numeric(icc.juge1),as.numeric(icc.juge2)))
  }
```
#SECOND FONCTION : bootstrap function, split on the hirarchical level as you want
```
  nagakawa.boot <- function(data,x){
list.ICC <- split(x = data, f = paste(data$juge.L,data$injection.L,sep = "_"))
    list.BOOT <- lapply(X = list.ICC, FUN = function(y){
      y[x,]
    })
    db.BOOT <- do.call(what = "rbind", args = list.BOOT)
    nagakawa(dataICC = db.BOOT)
  }

TERCERO: ejecución bootstrap

ICC.BOOT <- boot(data = dbICC, statistic = nagakawa.boot, R = 1000)