y
Najpierw ładujemy zestaw danych @ Wolfganga (nie pokazano tutaj). Teraz zdefiniujmy prostą funkcję R, która pobiera ramkę danych i zwraca pojedynczą losowo wybraną parę obserwacji z tej samej grupy:
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"])
}
Oto przykład tego, co otrzymamy, jeśli wywołamy tę funkcję 10 razy w zestawie danych @ 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
Aby oszacować ICC, wywołujemy tę funkcję wiele razy, a następnie obliczamy korelację między dwiema kolumnami.
random_pairs <- replicate(100000, get_random_pair(dat))
cor(t(random_pairs))
# [,1] [,2]
# [1,] 1.0000000 0.7493072
# [2,] 0.7493072 1.0000000
Tę samą procedurę można zastosować, bez żadnych modyfikacji, do zbiorów danych z grupami dowolnej wielkości. Na przykład stwórzmy zestaw danych składający się ze 100 grup po 100 obserwacji każda, z prawdziwym ICC ustawionym na 0,75, jak w przykładzie @ Wolfganga.
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")
Szacując ICC na podstawie składników wariancji z modelu mieszanego, otrzymujemy:
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
A jeśli zastosujemy losową procedurę parowania, otrzymamy
random_pairs <- replicate(100000, get_random_pair(dat))
cor(t(random_pairs))
# [,1] [,2]
# [1,] 1.0000000 0.7503004
# [2,] 0.7503004 1.0000000
co ściśle zgadza się z oszacowaniem elementu wariancji.
Zauważ, że chociaż losowa procedura parowania jest intuicyjna i dydaktycznie przydatna, metoda zilustrowana przez @ Wolfganga jest w rzeczywistości o wiele mądrzejsza. W przypadku zestawu danych takiego jak ten o rozmiarze 100 * 100 liczba unikalnych par wewnątrzgrupowych (bez parowania własnego) wynosi 505 000 - duża, ale nie astronomiczna liczba - więc możemy całkowicie obliczyć korelację kompletnie wyczerpanego zestawu wszystkich możliwych par, zamiast konieczności losowego próbkowania z zestawu danych. Oto funkcja pobierania wszystkich możliwych par dla ogólnego przypadku z grupami dowolnej wielkości:
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"])
}))
}
Teraz, jeśli zastosujemy tę funkcję do zestawu danych 100 * 100 i obliczymy korelację, otrzymamy:
cor(get_all_pairs(dat))
# [,1] [,2]
# [1,] 1.0000000 0.7504817
# [2,] 0.7504817 1.0000000
To, co dobrze zgadza się z pozostałymi dwoma oszacowaniami i w porównaniu z procedurą losowego parowania, jest znacznie szybsze do obliczenia, a także powinno być bardziej wydajnym oszacowaniem w sensie mniejszej wariancji.
