y
Đầu tiên chúng tôi tải tập dữ liệu của @ Wolfgang (không hiển thị ở đây). Bây giờ, hãy xác định một hàm R đơn giản lấy data.frame và trả về một cặp quan sát được chọn ngẫu nhiên từ cùng một nhóm:
get_random_pair <- function(df){
# select a random row
i <- sample(nrow(df), 1)
# select a random other row from the same group
# (the call to rep() here is admittedly odd, but it's to avoid unwanted
# behavior when the first argument to sample() has length 1)
j <- sample(rep(setdiff(which(dat$group==dat[i,"group"]), i), 2), 1)
# return the pair of y-values
c(df[i,"y"], df[j,"y"])
}
Đây là một ví dụ về những gì chúng ta nhận được nếu chúng ta gọi hàm này 10 lần trên tập dữ liệu của @ Wolfgang:
test <- replicate(10, get_random_pair(dat))
t(test)
# [,1] [,2]
# [1,] 9 6
# [2,] 2 2
# [3,] 2 4
# [4,] 3 5
# [5,] 3 2
# [6,] 2 4
# [7,] 7 9
# [8,] 5 3
# [9,] 5 3
# [10,] 3 2
Bây giờ để ước tính ICC, chúng ta chỉ cần gọi hàm này một số lần lớn và sau đó tính toán mối tương quan giữa hai cột.
random_pairs <- replicate(100000, get_random_pair(dat))
cor(t(random_pairs))
# [,1] [,2]
# [1,] 1.0000000 0.7493072
# [2,] 0.7493072 1.0000000
Quy trình tương tự này có thể được áp dụng, hoàn toàn không có sửa đổi đối với các bộ dữ liệu với các nhóm có kích thước bất kỳ. Ví dụ: hãy tạo một bộ dữ liệu bao gồm 100 nhóm 100 quan sát mỗi nhóm, với ICC thực được đặt thành 0,75 như trong ví dụ của @ Wolfgang.
set.seed(12345)
group_effects <- scale(rnorm(100))*sqrt(4.5)
errors <- scale(rnorm(100*100))*sqrt(1.5)
dat <- data.frame(group = rep(1:100, each=100),
person = rep(1:100, times=100),
y = rep(group_effects, each=100) + errors)
stripchart(y ~ group, data=dat, pch=20, col=rgb(0,0,0,.1), ylab="group")
Ước tính ICC dựa trên các thành phần phương sai từ một mô hình hỗn hợp, chúng tôi nhận được:
library("lme4")
mod <- lmer(y ~ 1 + (1|group), data=dat, REML=FALSE)
summary(mod)
# Random effects:
# Groups Name Variance Std.Dev.
# group (Intercept) 4.502 2.122
# Residual 1.497 1.223
# Number of obs: 10000, groups: group, 100
4.502/(4.502 + 1.497)
# 0.7504584
Và nếu chúng ta áp dụng quy trình ghép đôi ngẫu nhiên, chúng ta sẽ nhận được
random_pairs <- replicate(100000, get_random_pair(dat))
cor(t(random_pairs))
# [,1] [,2]
# [1,] 1.0000000 0.7503004
# [2,] 0.7503004 1.0000000
mà rất phù hợp với ước tính thành phần phương sai.
Lưu ý rằng mặc dù quy trình ghép nối ngẫu nhiên là loại trực quan và hữu dụng về mặt thực tế, phương pháp được minh họa bởi @Wolfgang thực sự thông minh hơn rất nhiều. Đối với một tập dữ liệu như thế này có kích thước 100 * 100, số lượng các cặp trong nhóm duy nhất (không bao gồm tự ghép) là 505.000 - một con số lớn nhưng không phải là thiên văn - vì vậy chúng tôi hoàn toàn có thể tính toán tương quan của tập hợp đầy đủ tất cả các cặp có thể, thay vì cần lấy mẫu ngẫu nhiên từ bộ dữ liệu. Đây là một chức năng để truy xuất tất cả các cặp có thể có cho trường hợp chung với các nhóm có kích thước bất kỳ:
get_all_pairs <- function(df){
# do this for every group and combine the results into a matrix
do.call(rbind, by(df, df$group, function(group_df){
# get all possible pairs of indices
i <- expand.grid(seq(nrow(group_df)), seq(nrow(group_df)))
# remove self-pairings
i <- i[i[,1] != i[,2],]
# return a 2-column matrix of the corresponding y-values
cbind(group_df[i[,1], "y"], group_df[i[,2], "y"])
}))
}
Bây giờ nếu chúng ta áp dụng hàm này cho tập dữ liệu 100 * 100 và tính toán tương quan, chúng ta sẽ nhận được:
cor(get_all_pairs(dat))
# [,1] [,2]
# [1,] 1.0000000 0.7504817
# [2,] 0.7504817 1.0000000
Điều này cũng phù hợp với hai ước tính còn lại và so với quy trình ghép ngẫu nhiên, tính toán nhanh hơn nhiều và cũng là một ước tính hiệu quả hơn theo nghĩa có ít phương sai.