Một số âm mưu để khám phá dữ liệu
Dưới đây là tám, một cho mỗi số lượng tiếp xúc bề mặt, các ô xy hiển thị găng tay so với không có găng tay.
Mỗi cá nhân được vẽ với một dấu chấm. Giá trị trung bình và phương sai và hiệp phương sai được biểu thị bằng một chấm đỏ và hình elip (khoảng cách Mahalanobis tương ứng với 97,5% dân số).
Bạn có thể thấy rằng các hiệu ứng chỉ nhỏ so với sự lây lan của dân số. Giá trị trung bình cao hơn đối với 'không có găng tay' và giá trị trung bình thay đổi cao hơn một chút đối với các tiếp xúc bề mặt nhiều hơn (có thể được hiển thị là đáng kể). Nhưng hiệu ứng chỉ có kích thước nhỏ (tổng thể giảm nhật ký ) và có nhiều cá nhân thực sự có số lượng vi khuẩn cao hơn với găng tay.14
Mối tương quan nhỏ cho thấy thực sự có một hiệu ứng ngẫu nhiên từ các cá nhân (nếu không có hiệu ứng từ người đó thì sẽ không có mối tương quan giữa găng tay cặp và không găng tay). Nhưng đó chỉ là một hiệu ứng nhỏ và một cá nhân có thể có các hiệu ứng ngẫu nhiên khác nhau đối với 'găng tay' và 'không găng tay' (ví dụ: đối với tất cả các điểm tiếp xúc khác nhau, cá nhân có thể có số lượng cao hơn / thấp hơn cho 'găng tay' so với 'không găng tay') .
Dưới đây là các ô riêng biệt cho mỗi 35 cá nhân. Ý tưởng của âm mưu này là để xem liệu hành vi đó có đồng nhất hay không và cũng để xem loại chức năng nào có vẻ phù hợp.
Lưu ý rằng 'không có găng tay' có màu đỏ. Trong hầu hết các trường hợp, đường màu đỏ cao hơn, nhiều vi khuẩn hơn cho các trường hợp 'không có găng tay'.
Tôi tin rằng một cốt truyện tuyến tính là đủ để nắm bắt các xu hướng ở đây. Nhược điểm của biểu đồ bậc hai là các hệ số sẽ khó diễn giải hơn (bạn sẽ không thấy trực tiếp độ dốc là dương hay âm vì cả thuật ngữ tuyến tính và thuật ngữ bậc hai đều có ảnh hưởng đến điều này).
Nhưng quan trọng hơn là bạn thấy rằng các xu hướng khác nhau rất nhiều giữa các cá nhân khác nhau và do đó, có thể hữu ích khi thêm một hiệu ứng ngẫu nhiên cho không chỉ đánh chặn, mà cả độ dốc của cá nhân.
Mô hình
Với mô hình dưới đây
- Mỗi cá nhân sẽ có đường cong riêng được trang bị (hiệu ứng ngẫu nhiên cho các hệ số tuyến tính).
- y∼N(log(μ),σ2)log(y)∼N(μ,σ2)
- Trọng lượng được áp dụng vì dữ liệu không đồng nhất. Các biến thể hẹp hơn đối với các số cao hơn. Điều này có thể là do số lượng vi khuẩn có một số trần và sự biến đổi chủ yếu là do không truyền được từ bề mặt sang ngón tay (= liên quan đến số lượng thấp hơn). Xem thêm trong 35 lô. Chủ yếu có một vài cá nhân mà biến thể cao hơn nhiều so với những người khác. (chúng tôi cũng thấy các đuôi lớn hơn, quá mức, trong các ô qq)
- Không có thuật ngữ chặn được sử dụng và thuật ngữ 'tương phản' được thêm vào. Điều này được thực hiện để làm cho các hệ số dễ giải thích hơn.
.
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)
Điều này mang lại
> 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
mã để lấy lô
hóa học :: chức năng 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()
}
Lô 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))
}
Lô 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')
}
NumberContactsnhư một yếu tố số và bao gồm một thuật ngữ đa thức bậc hai / bậc ba. Hoặc nhìn vào các mô hình hỗn hợp phụ gia tổng quát.