Bootstrapping dữ liệu phân cấp / đa cấp (lấy mẫu lại cụm)


9

Tôi đang sản xuất một tập lệnh để tạo các mẫu bootstrap từ catsbộ dữ liệu (từ -MASS-gói).

Theo sách giáo khoa Davidson và Hinkley [1] Tôi đã thực hiện một hồi quy tuyến tính đơn giản và áp dụng một quy trình phi tham số cơ bản để khởi động từ các quan sát iid, cụ thể là ghép cặp .

Mẫu ban đầu có dạng:

Bwt   Hwt

2.0   7.0
2.1   7.2

...

1.9    6.8

Thông qua một mô hình tuyến tính đơn biến, chúng tôi muốn giải thích trọng lượng của mèo thông qua trọng lượng não của chúng.

Mã này là:

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)

Giả sử bây giờ tồn tại một biến cụm cluster = 1, 2,..., 24(ví dụ, mỗi con mèo thuộc về một lứa nhất định). Để đơn giản, giả sử rằng dữ liệu được cân bằng: chúng tôi có 6 quan sát cho mỗi cụm. Do đó, mỗi trong số 24 lứa được tạo thành từ 6 con mèo (tức là n_cluster = 6n = 144).

Có thể tạo một clusterbiến giả thông qua:

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

Tôi có hai câu hỏi liên quan:

Làm thế nào để mô phỏng các mẫu theo cấu trúc tập dữ liệu (cụm)? Đó là, làm thế nào để lấy mẫu lại ở cấp độ cụm? Tôi muốn lấy mẫu các cụm thay thế và đặt các quan sát trong mỗi cụm được chọn như trong tập dữ liệu ban đầu (nghĩa là lấy mẫu với thay thế các cụm và không thay thế các quan sát trong mỗi cụm).

Đây là chiến lược được đề xuất bởi Davidson (trang 100). Giả sử chúng ta vẽ B = 100mẫu. Mỗi trong số chúng nên được tạo bởi 24 cụm có thể lặp lại (ví dụ 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) và mỗi cụm nên chứa 6 quan sát tương tự của tập dữ liệu gốc. Làm thế nào để làm điều đó trong R? (có hoặc không có -boot-gói.) Bạn có đề xuất thay thế nào để tiếp tục không?

Câu hỏi thứ hai liên quan đến mô hình hồi quy ban đầu. Giả sử tôi áp dụng mô hình hiệu ứng cố định , với các mức chặn cấp cụm. Nó có thay đổi quy trình lấy mẫu lại được thông qua không?

[1] Davidson, AC, Hinkley, DV (1997). Phương pháp Bootstrap và các ứng dụng của họ . Đại học Cambridge báo chí.

Câu trả lời:


9

Lấy mẫu lại toàn bộ các cụm đã được biết đến trong các thống kê khảo sát miễn là mọi phương pháp lấy mẫu lại đã được sử dụng ở đó (đó là, từ giữa những năm 1960), vì vậy đây là một phương pháp được thiết lập tốt. Xem bộ sưu tập các liên kết của tôi tại http://www.citeulike.org/user/ctacmo/tag/survey_resampling . Cho dù bootcó thể làm điều này hay không, tôi không biết; Tôi sử dụng surveygói khi tôi cần làm việc với khảo sát bootstraps, mặc dù lần trước tôi đã kiểm tra, nó không có tất cả các chức năng tôi cần (như một số chỉnh sửa mẫu nhỏ, theo như tôi có thể nhớ lại).

Tôi không nghĩ rằng việc áp dụng một mô hình cụ thể như hiệu ứng cố định sẽ thay đổi nhiều thứ, nhưng, IMO, bootstrap còn lại tạo ra rất nhiều giả định mạnh mẽ (phần dư là iid, mô hình được chỉ định chính xác). Mọi người trong số họ đều dễ dàng bị phá vỡ, và cấu trúc cụm chắc chắn phá vỡ giả định iid.

Đã có một số tài liệu kinh tế lượng về bootstrap hoang dã. Họ giả vờ rằng họ làm việc trong chân không mà không cần tất cả năm mươi năm nghiên cứu thống kê khảo sát về chủ đề này, vì vậy tôi không chắc chắn nên làm gì với nó.


Nghi ngờ chính của tôi về việc tạo hiệu ứng cố định ở cấp độ cụm là trong một số mẫu mô phỏng có thể xảy ra rằng chúng tôi đã không chọn một số cụm ban đầu, do đó không thể xác định được các chặn cụ thể của cụm liên quan. Nếu bạn đã xem mã tôi đã đăng, thì đó không phải là vấn đề từ quan điểm "cơ học" (ở mỗi lần lặp, chúng ta có thể điều chỉnh một mô hình FE khác nhau chỉ bằng các lần chặn của các cụm được lấy mẫu). Tôi đã tự hỏi liệu có một vấn đề "thống kê" trong tất cả những điều này hay không
Stefano Lombardi

3

Tôi đã cố gắng tự giải quyết vấn đề và tôi đã tạo ra đoạn mã sau.

Mặc dù nó hoạt động, nó có thể có thể được cải thiện về tốc độ. Ngoài ra, nếu có thể, tôi muốn tìm cách sử dụng -boot-gói, vì nó cho phép tự động tính toán một số khoảng tin cậy khởi động thông qua boot.ci...

Để đơn giản, bộ dữ liệu bắt đầu bao gồm 18 con mèo (các quan sát "cấp thấp hơn") được lồng trong 6 phòng thí nghiệm (biến cụm). Bộ dữ liệu được cân bằng ( n_cluster = 3cho mỗi cụm). Chúng tôi có một hồi quy x, để giải thích y.

Bộ dữ liệu giả và ma trận nơi lưu trữ kết quả là:

  # 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)

Ở mỗi Blần lặp, các vòng lặp sau đây sẽ lấy mẫu 6 cụm thay thế, mỗi cụm được tạo bởi 3 con mèo được lấy mẫu mà không thay thế (nghĩa là thành phần bên trong của cụm được duy trì không thay đổi). Các ước tính của hệ số hồi quy và sai số chuẩn của nó được lưu trữ trong ma trận được tạo trước đó:

  ####################################
  #   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

  }

Hy vọng điều này sẽ giúp, Lando


sử dụng vòng lặp for phải được chi phối bằng cách sử dụng replicate; như một phần thưởng, nó sẽ tự động trả về b.samplemảng cho bạn. Ngoài ra, với tất cả sự hợp nhất ở đây, bạn gần như chắc chắn sẽ tốt hơn khi sử dụng data.tablevà lấy mẫu lại bằng cách key. Tôi có thể đóng góp câu trả lời khi vào máy tính ... Câu hỏi: tại sao bạn theo dõi các lỗi tiêu chuẩn của hệ số?
MichaelChirico

Cảm ơn @MichaelChirico, tôi đồng ý. Nếu tôi nhớ rõ, tôi đã lưu các lỗi tiêu chuẩn để vẽ các khoảng tin cậy sau này.
Stefano Lombardi

không nên khoảng tin cậy chỉ là lượng tử của phân phối hệ số bootstrap? tức là với khoảng tin cậy 95%,quantile(b.sample[,2], c(.025, .975))
MichaelChirico

3

Đây là một cách đơn giản hơn (và gần như nhanh hơn chắc chắn) để thực hiện bootstrapping bằng cách sử dụng data.table(trên dữ liệu của @ Lando.carlissian):

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

2

Tôi đã phải làm điều này gần đây và sử dụng dplyr. Giải pháp không thanh lịch như với data.table, nhưng:

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))
})

Các inner_joinlặp đi lặp lại mỗi hàng có một giá trị nhất định xcủa clusterbằng của số lần xxuất hiện trong cluster_sample.


0

Xin chào, một giải pháp rất đơn giản dựa trên sự phân chia và lapply, không cần gói cụ thể ngoại trừ "khởi động", ví dụ với ước tính ICC dựa trên thủ tục 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)
  }

THIRD: thực thi bootstrap

ICC.BOOT <- boot(data = dbICC, statistic = nagakawa.boot, R = 1000)
Khi sử dụng trang web của chúng tôi, bạn xác nhận rằng bạn đã đọc và hiểu Chính sách cookieChính sách bảo mật của chúng tôi.
Licensed under cc by-sa 3.0 with attribution required.