Quelques parcelles pour explorer les données
Ci-dessous, huit, un pour chaque nombre de contacts de surface, des tracés xy montrant des gants par rapport à l'absence de gants.
Chaque individu est tracé avec un point. La moyenne et la variance et la covariance sont indiquées par un point rouge et l'ellipse (distance de Mahalanobis correspondant à 97,5% de la population).
Vous pouvez voir que les effets ne sont que faibles par rapport à la répartition de la population. La moyenne est plus élevée pour «pas de gants» et la moyenne change un peu plus haut pour plus de contacts de surface (ce qui peut être significatif). Mais l'effet n'est que de petite taille ( réduction globale du log ), et il y a beaucoup d'individus pour qui il y a en fait un plus grand nombre de bactéries avec les gants.14
La petite corrélation montre qu'il y a en effet un effet aléatoire des individus (s'il n'y a pas eu d'effet de la personne alors il ne devrait pas y avoir de corrélation entre les gants appariés et pas de gants). Mais ce n'est qu'un petit effet et un individu peut avoir des effets aléatoires différents pour les «gants» et «pas de gants» (par exemple, pour tous les points de contact différents, l'individu peut avoir systématiquement un nombre plus élevé / plus faible de «gants» que de «pas de gants») .
Le graphique ci-dessous présente des graphiques distincts pour chacun des 35 individus. L'idée de cette intrigue est de voir si le comportement est homogène et aussi de voir quel type de fonction semble convenir.
Notez que le «sans gants» est en rouge. Dans la plupart des cas, la ligne rouge est plus élevée, plus de bactéries pour les cas «sans gants».
Je crois qu'un tracé linéaire devrait être suffisant pour saisir les tendances ici. L'inconvénient du tracé quadratique est que les coefficients seront plus difficiles à interpréter (vous ne verrez pas directement si la pente est positive ou négative car le terme linéaire et le terme quadratique ont tous deux une influence sur cela).
Mais plus important encore, vous voyez que les tendances diffèrent beaucoup entre les différents individus et qu'il peut donc être utile d'ajouter un effet aléatoire non seulement pour l'interception, mais aussi pour la pente de l'individu.
Modèle
Avec le modèle ci-dessous
- Chaque individu obtiendra sa propre courbe ajustée (effets aléatoires pour les coefficients linéaires).
- Le modèle utilise des données transformées en logarithme et correspond à un modèle linéaire régulier (gaussien). Dans les commentaires, l'amibe a mentionné qu'un lien de journal n'est pas lié à une distribution lognormale. Mais c'est différent. est différent delog ( y ) ∼ N ( μ , σ 2 )y∼ N( journal( μ ) , σ2)Journal( y) ∼ N( μ , σ2)
- Des pondérations sont appliquées car les données sont hétéroscédastiques. La variation est plus étroite vers les nombres plus élevés. Cela est probablement dû au fait que le nombre de bactéries a un certain plafond et que la variation est principalement due à une transmission défaillante de la surface au doigt (= liée à un nombre inférieur). Voir aussi dans les 35 graphiques. Il y a principalement quelques individus pour lesquels la variation est beaucoup plus élevée que les autres. (on voit aussi des queues plus grosses, une surdispersion, dans les parcelles qq)
- Aucun terme d'interception n'est utilisé et un terme de «contraste» est ajouté. Ceci est fait pour rendre les coefficients plus faciles à interpréter.
.
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)
Cela donne
> 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
code pour obtenir des tracés
chimiométrie :: fonction 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 parcelle
#### 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))
}
Terrain 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
comme facteur numérique et inclure des termes polynomiaux quadratiques / cubiques. Ou regardez dans les modèles mixtes additifs généralisés.