Correlación Intraclase y Efecto del Diseño en Muestreo por Conglomerados: Ejemplo Práctico en R
Matemáticas2,86 KB
Correlación Intraclase
mues<-cbind(conglo=rep(1:6,rep(20,6)),mu)
str(mues)
anva<-anova(lm(Gasto~as.factor(conglo),data=mues))
Mbar<-20
N<-120
n<-6
f<-n/N
scdc<-anva[2,2]
sctotal<-scdc+anva[1,2]
corr_intra<-1-(Mbar/(Mbar-1))*(scdc/sctotal)
corr_intra # Conglomerados de igual tamaño
[1] -0.02896894
Efecto del Diseño
cmec<-anva[1,3]
cmdc<-anva[2,3]
s2<-(cmec+(Mbar-1)*cmdc)/Mbar
r2conglo<-1-cmdc/s2
r2conglo # Correlación general
efec_dise<-1+corr_intra*(Mbar-1)
[1] 0.4495901
varianza<-(1-f)*s2*efec_dise/(12*20)
[1] 6.545171
Tamaño de Muestra
Muestreo por Conglomerados (MAS equivalente)
nMAS<-ceiling(120/efec_dise)
Nueva variabilidad (0.16%)
V0<-(0.0016*ybarc1)^2
nn<-sd(ybari)^2/V0
naj<-ceiling(nn/(1+nn/12))
Conglomerados de Segunda Etapa
str(iphon)
# (USM)
M<-nrow(iphon)
# Número de distritos (UPM)
N<-12
# Número de puntos por distrito
Mbar<-20
# Número de puntos a muestrear
n<-4
Selección
Selección de distritos (primera etapa)
distritos<-iphon[,2]
dist<-c("Surco","San Borja","VMT","SJM","LA PERLA","LA MOLINA","ATE","COMAS","VICTORIA","CERCADO","RIMAC","SJL")
set.seed(49)
sample(dist,6)
[1] "CERCADO" "LA MOLINA" "LA PERLA" "RIMAC" "Surco" "VMT"
Selección de puntos de venta por distrito (segunda etapa)
set.seed(15)
surco<-iphon[sample(1:20,4),]
set.seed(16)
vmt<-iphon[sample(41:60,4),]
set.seed(17)
perla<-iphon[sample(81:100,4),]
set.seed(18)
moli<-iphon[sample(101:120,4),]
set.seed(19)
cerca<-iphon[sample(181:200,4),]
set.seed(20)
rimac<-iphon[sample(201:220,4),]
mu<-rbind(surco,vmt,perla,moli,cerca,rimac)
str(mu)
Estimación de la Media
Estimación
f1<-6/12
f2<-4/20
f<-f1+f2
gasxdis<-rbind(sum(surco1),sum(vmt1),sum(moli1),sum(cerca1),sum(rimac1),sum(perla1))
total<-sum(gasxdis)
ybari<-gasxdis/4
ybarc1<-mean(ybari)
eeybarc1<-sd(ybari)*sqrt((1-0.7)/4)
aij<-rbind(table(surco2)[2],table(vmt2)[2],table(perla2)[2],table(moli2)[2],table(cerca2)[2],table(rimac2)[2])
pi<-aij/4
pcon<-sum(pi)/6
s2n<-sum((pi-pcon)^2)/5
s2m<-sum((aij-pi)^2/(6*(4-1)))
varp<-(1-f1)*s2n/6+(1-f2)*s2m/24