บางแปลงมีการสำรวจข้อมูล
ด้านล่างคือแปดหนึ่งรายการสำหรับหน้าสัมผัสพื้นผิวแต่ละจำนวน xy พล็อตที่แสดงถุงมือกับถุงมือ
บุคคลแต่ละคนถูกพล็อตด้วยจุด ค่าเฉลี่ยและความแปรปรวนและความแปรปรวนร่วมจะถูกระบุด้วยจุดสีแดงและวงรี (ระยะทาง Mahalanobis สอดคล้องกับ 97.5% ของประชากร)
คุณจะเห็นว่าเอฟเฟกต์เล็ก ๆ น้อย ๆ เมื่อเปรียบเทียบกับการแพร่กระจายของประชากร ค่าเฉลี่ยสูงกว่าสำหรับ 'ไม่มีถุงมือ' และค่าเฉลี่ยเปลี่ยนสูงขึ้นเล็กน้อยสำหรับการสัมผัสพื้นผิวเพิ่มเติม (ซึ่งสามารถแสดงให้เห็นว่ามีนัยสำคัญ) แต่เอฟเฟกต์มีเพียงขนาดเล็ก (โดยรวม14ลดลงเข้าสู่ระบบ) และมีบุคคลหลายคนที่มีจริงแบคทีเรียสูงนับกับถุงมือ
ความสัมพันธ์ขนาดเล็กแสดงให้เห็นว่ามีผลแบบสุ่มจากบุคคล (ถ้าไม่มีผลกระทบจากบุคคลดังนั้นไม่ควรมีความสัมพันธ์ระหว่างถุงมือที่จับคู่กับถุงมือไม่มี) แต่มันเป็นเพียงเอฟเฟกต์เล็ก ๆ น้อย ๆ และแต่ละคนอาจมีเอฟเฟกต์แบบสุ่มสำหรับ 'ถุงมือ' และ 'ไม่มีถุงมือ' (เช่นสำหรับจุดสัมผัสที่แตกต่างกันทั้งหมดบุคคลอาจมีจำนวนสูงกว่า / ต่ำกว่า 'ถุงมือ' มากกว่า 'ไม่มีถุงมือ') .
พล็อตด้านล่างเป็นแปลงที่แยกกันสำหรับแต่ละบุคคล 35 คน แนวคิดของพล็อตนี้คือการดูว่าพฤติกรรมนั้นเป็นเนื้อเดียวกันหรือไม่และเพื่อดูว่าฟังก์ชั่นประเภทใดที่เหมาะสม
โปรดทราบว่า 'ไม่มีถุงมือ' เป็นสีแดง ในกรณีส่วนใหญ่เส้นสีแดงจะสูงกว่าและมีแบคทีเรียมากขึ้นสำหรับกรณีที่ไม่มีถุงมือ
ฉันเชื่อว่าพล็อตเชิงเส้นควรเพียงพอที่จะจับแนวโน้มที่นี่ ข้อเสียของพล็อตกำลังสองคือสัมประสิทธิ์จะยากต่อการตีความ (คุณไม่เห็นโดยตรงว่าลาดเป็นบวกหรือลบเพราะทั้งเชิงเส้นและเทอมมีอิทธิพลกับเรื่องนี้)
แต่ที่สำคัญกว่านั้นคุณจะเห็นว่าแนวโน้มแตกต่างกันมากในแต่ละบุคคลดังนั้นจึงอาจมีประโยชน์ในการเพิ่มเอฟเฟกต์แบบสุ่มสำหรับไม่เพียง แต่การสกัดกั้น แต่ยังรวมถึงความชันของแต่ละบุคคลด้วย
แบบ
ด้วยรูปแบบด้านล่าง
- แต่ละคนจะได้รับการติดตั้งโค้งของมัน (เอฟเฟกต์แบบสุ่มสำหรับค่าสัมประสิทธิ์เชิงเส้น)
- โมเดลใช้ข้อมูลที่บันทึกการแปลงและเหมาะสมกับโมเดลเชิงเส้นปกติ (เกาส์เซียน) ในความคิดเห็นของอะมีบากล่าวว่าลิงค์บันทึกไม่เกี่ยวข้องกับการแจกแจงล็อกปกติ แต่นี่แตกต่างy∼N(log(μ),σ2) แตกต่างจาก log(y)∼N(μ,σ2)
- น้ำหนักถูกนำไปใช้เนื่องจากข้อมูลเป็น heteroskedastic ชุดรูปแบบจะแคบลงต่อจำนวนที่มากขึ้น นี่อาจเป็นเพราะจำนวนแบคทีเรียมีเพดานบางส่วนและความแปรปรวนส่วนใหญ่เกิดจากความผิดพลาดในการส่งผ่านจากพื้นผิวสู่นิ้ว (= เกี่ยวข้องกับจำนวนที่น้อยกว่า) ดูเพิ่มเติมใน 35 แปลง มีคนส่วนใหญ่ไม่กี่คนที่การเปลี่ยนแปลงจะสูงกว่าคนอื่น ๆ (เราเห็นหางที่ใหญ่กว่า, การกระจายเกินพิกัดใน qq-plot)
- ไม่มีการใช้คำดักจับและเพิ่มคำว่า 'ตรงกันข้าม' สิ่งนี้ทำเพื่อให้สัมประสิทธิ์การตีความง่ายขึ้น
.
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
รหัสเพื่อรับแปลง
chemometrics :: ฟังก์ชัน 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เป็นปัจจัยตัวเลขและรวมคำพหุนาม / กำลังสอง หรือดูที่โมเดลเสริมแบบผสมทั่วไป