Деякі сюжети для вивчення даних
Нижче - вісім, по одному на кожну кількість поверхневих контактів, сюжети xy, що показують рукавички проти рукавичок.
Кожна людина зображена крапкою. Середнє значення та дисперсія та коваріація позначаються червоною крапкою та еліпсом (відстань махаланобіса, що відповідає 97,5% населення).
Ви можете бачити, що ефекти лише невеликі порівняно з поширенням населення. Середнє значення вище для "без рукавичок", а середнє змінюється трохи вище в порівнянні з більш поверхневими контактами (що може бути значним). Але ефект має невеликі розміри (загальний а14скорочення журналу), і є багато людей, для яких насправді більший кількість бактерій з рукавичками.
Невелике співвідношення показує, що дійсно є випадковий ефект від осіб (якщо не було ефекту від людини, то не повинно бути кореляції між парними рукавичками та відсутністю рукавичок). Але це лише невеликий ефект і людина може мати різні випадкові ефекти для "рукавичок" і "без рукавичок" (наприклад, для всіх різних контактних точок у індивіда можуть бути постійно більші / менші показники для "рукавичок", ніж "без рукавичок") .
Нижче ділянки - окремі ділянки для кожної з 35 особин. Ідея цього сюжету полягає в тому, щоб зрозуміти, чи поведінка однорідна, а також побачити, яка функція здається підходящою.
Зауважте, що "без рукавичок" червоного кольору. У більшості випадків червона лінія вище, більше бактерій для випадків "без рукавичок".
Я вважаю, що лінійного сюжету має бути достатньо, щоб відобразити тут тенденції. Недоліком квадратичного сюжету є те, що коефіцієнти будуть важче інтерпретувати (ви не побачите прямо, чи нахил позитивний чи негативний, оскільки як лінійний член, так і квадратичний член впливають на це).
Але ще важливіше, що ви бачите, що тенденції сильно відрізняються між різними особами, і тому може бути корисним додати випадковий ефект не тільки для перехоплення, але і нахилу людини.
Модель
З наведеною нижче моделлю
- Кожна людина отримає власну криву (випадкові ефекти для лінійних коефіцієнтів).
- Модель використовує дані, трансформовані журналом, і відповідає звичайній (гауссовій) лінійній моделі. У коментарях амеба згадував, що посилання на журнал не пов'язане з лонормальним розподілом. Але це інакше.у∼ N( журнал( мк ) ,σ2) відрізняється від журнал( у) ∼ N( мк ,σ2)
- Ваги застосовуються, оскільки дані гетероскдастичні. Варіація більш вузька до більшої кількості. Це, мабуть, тому, що кількість бактерій має деяку стелю, і відхилення в основному пов'язані з нестачею передачі від поверхні до пальця (= пов'язана з меншими показниками). Дивіться також у 35 сюжетах. В основному є кілька осіб, для яких варіація значно більша, ніж у інших. (ми також бачимо більші хвости, перенапруження в qq-графіках)
- Не використовується термін перехоплення і додається термін "контраст". Це робиться для полегшення інтерпретації коефіцієнтів.
.
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 х 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 х 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як числовий множник і включати квадратичний / кубічний многочлен. Або подивіться узагальнені додаткові змішані моделі.