데이터를 탐색하기위한 일부 도표
아래는 장갑을 표시하고 장갑을 표시하지 않는 xy 플롯입니다.
각 개인은 점으로 표시됩니다. 평균과 분산 및 공분산은 빨간색 점과 타원 (인구의 97.5 %에 해당하는 마할 라 노비스 거리)으로 표시됩니다.
인구 확산과 비교할 때 그 효과가 작다는 것을 알 수 있습니다. '장갑 없음'의 경우 평균이 높고 표면 접촉이 많을수록 평균이 약간 높아집니다 (중요한 것으로 표시 될 수 있음). 그러나 그 효과는 크기가 작습니다.14) 감소를 기록, 실제로 높은 박테리아 카운트가 누구인지에 대한 많은 사람들이 있습니다 와 장갑은.
작은 상관 관계는 실제로 개인으로부터 임의의 효과가 있음을 보여줍니다 (사람의 영향이 없다면 쌍 장갑과 장갑이 없음). 그러나 이는 작은 효과 일 뿐이며 개인은 '장갑'과 '장갑 없음'에 대해 다른 임의의 효과를 가질 수 있습니다 (예 : 모든 다른 접점의 경우 개인은 '장갑 없음'보다 '장갑'에 대해 지속적으로 높거나 낮은 수를 가질 수 있음) .
아래 그림은 35 명 각각에 대한 별도의 그림입니다. 이 그림의 개념은 동작이 동종인지 확인하고 어떤 기능이 적합한 지 확인하는 것입니다.
'장갑 없음'은 빨간색입니다. 대부분의 경우 레드 라인이 높고 '장갑이없는'경우에 더 많은 박테리아가 있습니다.
나는 추세를 포착하기에 선형 플롯이 충분해야한다고 생각합니다. 2 차 그림의 단점은 계수를 해석하기가 더 어렵다는 것입니다 (선형 항과 2 차 항이 모두 영향을 미치기 때문에 기울기가 양수인지 음수인지 직접 볼 수는 없습니다).
그러나 더 중요한 것은 추세가 개인마다 많이 다르므로 인터셉트뿐만 아니라 개인의 기울기에 무작위 효과를 추가하는 것이 유용 할 수 있다는 것을 알 수 있습니다.
모델
아래 모델로
- 각 개인은 자신의 곡선을 맞출 것입니다 (선형 계수에 대한 임의 효과).
- 이 모델은 로그 변환 된 데이터를 사용하며 일반 (가우시안) 선형 모델에 적합합니다. 의견에서 amoeba는 로그 링크가 로그 정규 분포와 관련이 없다고 언급했습니다. 그러나 이것은 다릅니다.와이~ N( 로그( μ ) ,σ2) ~와 다르다 로그( y) ∼ N( μ ,σ2)
- 데이터가이 분산이기 때문에 가중치가 적용됩니다. 숫자가 클수록 변동이 더 좁습니다. 이것은 아마도 박테리아 수에 약간의 천장이 있고 그 변화는 대부분 표면에서 손가락으로의 전달이 실패하기 때문일 것입니다 (= 낮은 수와 관련됨). 35 플롯에서 참조하십시오. 변화가 다른 사람들보다 훨씬 높은 개인이 주로 있습니다. (우리는 qq-plots에서 더 큰 꼬리, 과도한 분산을 볼 수 있습니다)
- 인터셉트 용어가 사용되지 않고 '대비'용어가 추가됩니다. 이것은 계수를 더 쉽게 해석하기 위해 수행됩니다.
.
K <- read.csv("~/Downloads/K.txt", sep="")
data <- K[K$Surface == 'P',]
Contactsnumber <- data$NumberContacts
Contactscontrast <- data$NumberContacts * (1-2*(data$Gloves == 'U'))
data <- cbind(data, Contactsnumber, Contactscontrast)
m <- lmer(log10CFU ~ 0 + Gloves + Contactsnumber + Contactscontrast +
(0 + Gloves + Contactsnumber + Contactscontrast|Participant) ,
data=data, weights = data$log10CFU)
이것은 준다
> summary(m)
Linear mixed model fit by REML ['lmerMod']
Formula: log10CFU ~ 0 + Gloves + Contactsnumber + Contactscontrast + (0 +
Gloves + Contactsnumber + Contactscontrast | Participant)
Data: data
Weights: data$log10CFU
REML criterion at convergence: 180.8
Scaled residuals:
Min 1Q Median 3Q Max
-3.0972 -0.5141 0.0500 0.5448 5.1193
Random effects:
Groups Name Variance Std.Dev. Corr
Participant GlovesG 0.1242953 0.35256
GlovesU 0.0542441 0.23290 0.03
Contactsnumber 0.0007191 0.02682 -0.60 -0.13
Contactscontrast 0.0009701 0.03115 -0.70 0.49 0.51
Residual 0.2496486 0.49965
Number of obs: 560, groups: Participant, 35
Fixed effects:
Estimate Std. Error t value
GlovesG 4.203829 0.067646 62.14
GlovesU 4.363972 0.050226 86.89
Contactsnumber 0.043916 0.006308 6.96
Contactscontrast -0.007464 0.006854 -1.09
줄거리를 얻는 코드
화학량 론 :: drawMahal 함수
# editted from chemometrics::drawMahal
drawelipse <- function (x, center, covariance, quantile = c(0.975, 0.75, 0.5,
0.25), m = 1000, lwdcrit = 1, ...)
{
me <- center
covm <- covariance
cov.svd <- svd(covm, nv = 0)
r <- cov.svd[["u"]] %*% diag(sqrt(cov.svd[["d"]]))
alphamd <- sqrt(qchisq(quantile, 2))
lalpha <- length(alphamd)
for (j in 1:lalpha) {
e1md <- cos(c(0:m)/m * 2 * pi) * alphamd[j]
e2md <- sin(c(0:m)/m * 2 * pi) * alphamd[j]
emd <- cbind(e1md, e2md)
ttmd <- t(r %*% t(emd)) + rep(1, m + 1) %o% me
# if (j == 1) {
# xmax <- max(c(x[, 1], ttmd[, 1]))
# xmin <- min(c(x[, 1], ttmd[, 1]))
# ymax <- max(c(x[, 2], ttmd[, 2]))
# ymin <- min(c(x[, 2], ttmd[, 2]))
# plot(x, xlim = c(xmin, xmax), ylim = c(ymin, ymax),
# ...)
# }
}
sdx <- sd(x[, 1])
sdy <- sd(x[, 2])
for (j in 2:lalpha) {
e1md <- cos(c(0:m)/m * 2 * pi) * alphamd[j]
e2md <- sin(c(0:m)/m * 2 * pi) * alphamd[j]
emd <- cbind(e1md, e2md)
ttmd <- t(r %*% t(emd)) + rep(1, m + 1) %o% me
# lines(ttmd[, 1], ttmd[, 2], type = "l", col = 2)
lines(ttmd[, 1], ttmd[, 2], type = "l", col = 1, lty=2) #
}
j <- 1
e1md <- cos(c(0:m)/m * 2 * pi) * alphamd[j]
e2md <- sin(c(0:m)/m * 2 * pi) * alphamd[j]
emd <- cbind(e1md, e2md)
ttmd <- t(r %*% t(emd)) + rep(1, m + 1) %o% me
# lines(ttmd[, 1], ttmd[, 2], type = "l", col = 1, lwd = lwdcrit)
invisible()
}
5 x 7 플롯
#### getting data
K <- read.csv("~/Downloads/K.txt", sep="")
### plotting 35 individuals
par(mar=c(2.6,2.6,2.1,1.1))
layout(matrix(1:35,5))
for (i in 1:35) {
# selecting data with gloves for i-th participant
sel <- c(1:624)[(K$Participant==i) & (K$Surface == 'P') & (K$Gloves == 'G')]
# plot data
plot(K$NumberContacts[sel],log(K$CFU,10)[sel], col=1,
xlab="",ylab="",ylim=c(3,6))
# model and plot fit
m <- lm(log(K$CFU[sel],10) ~ K$NumberContacts[sel])
lines(K$NumberContacts[sel],predict(m), col=1)
# selecting data without gloves for i-th participant
sel <- c(1:624)[(K$Participant==i) & (K$Surface == 'P') & (K$Gloves == 'U')]
# plot data
points(K$NumberContacts[sel],log(K$CFU,10)[sel], col=2)
# model and plot fit
m <- lm(log(K$CFU[sel],10) ~ K$NumberContacts[sel])
lines(K$NumberContacts[sel],predict(m), col=2)
title(paste0("participant ",i))
}
2 x 4 플롯
#### plotting 8 treatments (number of contacts)
par(mar=c(5.1,4.1,4.1,2.1))
layout(matrix(1:8,2,byrow=1))
for (i in c(1:8)) {
# plot canvas
plot(c(3,6),c(3,6), xlim = c(3,6), ylim = c(3,6), type="l", lty=2, xlab='gloves', ylab='no gloves')
# select points and plot
sel1 <- c(1:624)[(K$NumberContacts==i) & (K$Surface == 'P') & (K$Gloves == 'G')]
sel2 <- c(1:624)[(K$NumberContacts==i) & (K$Surface == 'P') & (K$Gloves == 'U')]
points(K$log10CFU[sel1],K$log10CFU[sel2])
title(paste0("contact ",i))
# plot mean
points(mean(K$log10CFU[sel1]),mean(K$log10CFU[sel2]),pch=21,col=1,bg=2)
# plot elipse for mahalanobis distance
dd <- cbind(K$log10CFU[sel1],K$log10CFU[sel2])
drawelipse(dd,center=apply(dd,2,mean),
covariance=cov(dd),
quantile=0.975,col="blue",
xlim = c(3,6), ylim = c(3,6), type="l", lty=2, xlab='gloves', ylab='no gloves')
}
NumberContacts수치 요소로 사용 하고 2 차 / 입방 다항식 항을 포함 할 수 있습니다 . 또는 일반 첨가 혼합 모델을 살펴보십시오.