多次表面接触后手指上的细菌积聚：非正常数据，重复测量，交叉参与者

介绍

我有一些参与者在两种情况下反复接触被大肠杆菌污染的表面（A =戴手套，B =不戴手套）。我想知道戴着和不戴着手套的指尖上的细菌数量之间以及接触数之间是否存在差异。这两个因素都是参与者。

实验方法：

参与者（n = 35）用同一根手指触摸每个方块一次，最多8个接触点（见图a）。

然后，我擦拭参与者的手指，并在每次接触后测量指尖上的细菌。然后，他们用一根新手指触摸不同数量的表面，以此类推，从1到8个触点（见图b）。

这是真实数据：真实数据

该数据是非正态的，因此请参见下面的细菌边际分布| NumberContacts。x ＝细菌。每个方面都是不同数量的联系人。

模型

根据使用gamma（link =“ log”）和NumberContacts的多项式的变形虫的建议，从lme4 :: glmer尝试：

cfug<-glmer(CFU ~ Gloves + poly(NumberContacts,2) + (-1+NumberContacts|Participant),
            data=(K,CFU<4E5),
           family=Gamma(link="log")
            )
plot(cfug)

注意 Gamma（link =“ inverse”）不会说PIRLS减半未能减少偏差。

结果：

cfug的拟合vs残差

qqp（resid（cfug））

题：

是否正确定义了我的glmer模型，以纳入每个参与者的随机影响以及每个人都同时进行实验A和实验B的事实？

加成：

参与者之间似乎存在自相关。这可能是因为没有在同一天对它们进行测试，并且细菌瓶随着时间的推移而增长和下降。有关系吗？

acf（CFU，lag = 35）显示一个参与者与另一个参与者之间的显着相关性。

一些图来探索数据

下面是八个，每个对应的表面接触数，一个xy图显示手套与不戴手套。

每个人都有一个点。均值，方差和协方差用红点和椭圆形表示（Mahalanobis距离对应于总人口的97.5％）。

$\frac{1}{4}$对数减少），并有许多人对于究竟是谁更高的细菌计数有与手套。

较小的相关性表明确实存在来自个体的随机影响（如果没有来自人的影响，则配对的手套和没有手套之间应该没有相关性）。但这只是很小的影响，一个人可能会对“手套”和“没有手套”产生不同的随机影响（例如，对于所有不同的接触点，该人对“手套”的计数可能始终比“没有手套”的计数高/低） 。

下图是35个人中每个人的单独情节。该图的想法是查看行为是否同质，并查看哪种功能似乎合适。

请注意，“无手套”为红色。在大多数情况下，“没有手套”情况下的红线更高，细菌更多。

我认为线性图应该足以捕获此处的趋势。二次曲线图的缺点是系数将更难以解释（您不会直接看到斜率是正还是负，因为线性项和二次项都会对此产生影响）。

但是更重要的是，您会看到不同个体之间的趋势差异很大，因此，不仅对截距而且对个体的斜率添加随机效应可能很有用。

模型

与下面的模型

• 每个人都会得到自己的曲线拟合（线性系数的随机效应）。
• $y \sim N(\log(\mu),\sigma^2)$$\log(y) \sim N(\mu,\sigma^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

代码获取地块

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')
}

$^\dagger$

至于是使用模型MASS:glmmPQL还是lme4:glmer用于模型，我的理解是这两个函数将适合同一模型（只要您将模型方程式，分布和链接函数设置为相同），但是它们使用不同的估算方法来找到适合的模型。我可能会误会，但是从文档中我的理解是glmmPQL使用Wolfinger和O'Connell（1993）中所述的惩罚拟似然性，而glmer使用Gauss-Hermite正交。如果您担心它，可以使用这两种方法对模型进行拟合，并检查它们给出的系数估计是否相同，这样您将更有信心将拟合算法收敛到系数的真实MLE。

应该NumberContacts是一个分类因素？

该变量具有自然顺序，从您的图上可以看出它与响应变量具有平滑的关系，因此您可以合理地将其视为数字变量。如果要包括在内，factor(NumberContacts)则不会限制其形式，也不会失去很多自由度。您甚至可以使用交互Gloves*factor(NumberContacts)而不会失去太多的自由度。但是，值得考虑的是使用因子变量是否会涉及数据的过度拟合。假设绘图中存在相当平滑的关系，则简单的线性函数或二次函数将获得良好的结果而不会过度拟合。

如何制作Participant随机斜率而不截取变量？

您已经通过使用对数链接函数将响应变量置于对数标度上，因此的拦截效果为Participant响应提供了乘法效果。如果您要给它一个随机的斜率进行交互，NumberContacts那么它将对响应产生基于功率的影响。如果需要，可以使用(~ -1 + NumberContacts|Participant)它来删除截距，但根据接触点的数量添加斜率。

我应该使用Box-Cox转换数据吗？（例如lambda = 0.779）

$\lambda$

我应该包括方差权重吗？

首先查看您的残差图，看是否存在异方差的证据。根据您已经包含的图，在我看来这不是问题，因此您无需为方差添加任何权重。如有疑问，可以使用简单的线性函数添加权重，然后执行统计测试以查看权重的斜率是否平坦。这相当于对异方差性的正式测试，这将为您提供一些备份选择。

我应该在其中包含自相关NumberContacts吗？

如果您已经为参与者添加了一个随机影响项，那么在联系人数量上添加一个自相关项可能是一个坏主意。您的实验对不同数量的联系人使用了不同的手指，因此对于已经考虑了参与者的情况，您不会期望自相关。除了参与者效应之外，添加自相关项还意味着您认为即使是给定的参与者，基于接触的数量，不同手指的结局之间也存在条件依赖性。

$^\dagger$

确实，有理由认为，从一个参与者进行的测量并不独立于从另一参与者进行的测量。例如，某些人可能倾向于用更大（或更小）的力按动手指，这会影响他们在每个接触次数上的所有测量结果。

因此，在这种情况下，可以采用2次重复测量方差分析（ANOVA）。

另外，也可以将混合效应模型participant作为随机因素。这是一个更高级，更复杂的解决方案。