R：使用lme

Question

> dput(ds)
structure(list(id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4), group = c(0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0), time = c(-8, -7, -6, -5, -4, -3, -2, 
-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, -8, 
-7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 
11, 12, 13, -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 
6, 7, 8, 9, 10, 11, 12, -8, -7, -6, -5, -4), logp = c(-0.106518238782883, 
0.0460683181881905, -0.0259267091751099, -0.0920770391821861, 
-0.0587862282991409, -0.146838054060936, 0.316394656896591, 0.386766374111176, 
0.216139584779739, 0.496496677398682, 0.744125068187714, 1.14207077026367, 
1.46769917011261, 2.10771918296814, 2.43389391899109, 3.00657606124878, 
2.97612929344177, 3.03166913986206, 2.75816416740417, 2.91728544235229, 
2.77770042419434, 3.20467519760132, 2.86933851242065, 1.84179353713989, 
-0.817233979701996, -0.82701164484024, -0.61499285697937, -1.34559118747711, 
-1.35250663757324, -0.834566354751587, -0.520647764205933, -0.778047442436218, 
-0.33273184299469, -0.195379719138145, 0.0646273493766785, 0.571262776851654, 
0.85602605342865, 1.19794964790344, 1.64863336086273, 1.57206785678864, 
1.41767036914825, 1.53600764274597, 1.18928778171539, 1.28867197036743, 
1.24439525604248, 0.680216789245605, -0.905854284763336, -0.503940403461456, 
-0.496737480163574, -0.969260931015015, -0.69905811548233, -0.189700186252594, 
-0.205862492322922, 0.0627471879124641, 0.106655828654766, 0.626791179180145, 
0.704189598560333, 1.41776823997498, 1.77128207683563, 2.09421610832214, 
1.91853356361389, 1.87884366512299, 1.82477164268494, 1.24088478088379, 
1.55322957038879, 1.38231825828552, 0.904222905635834, -1.41923320293427, 
-1.76328778266907, -1.34167373180389, -0.942831516265869, -1.47784101963043
)), datalabel = "", time.stamp = "24 Mar 2011 15:17", .Names = c("id", 
"group", "time", "logp"), formats = c("%9.0g", "%9.0g", "%9.0g", 
"%9.0g"), types = c(254L, 254L, 254L, 254L), val.labels = c("", 
"", "", ""), var.labels = c("", "", "", ""), version = 12L, row.names = c("1", 
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", 
"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", 
"25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", 
"36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", 
"47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", 
"58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", 
"69", "70", "71", "72"), class = "data.frame")

我这里有一个72行（每个24个）的数据集，我有兴趣拟合混合模型/惩罚样条。

> head(ds)
  id group time        logp
1  1     0   -8 -0.10651824
2  1     0   -7  0.04606832
3  1     0   -6 -0.02592671
4  1     0   -5 -0.09207704
5  1     0   -4 -0.05878623
6  1     0   -3 -0.14683805

首先我创建一些截断的行函数：

ds$bf1 <- (ds$time+7)*I(ds$time > -7)
ds$bf2 <- (ds$time+3)*I(ds$time > -4)
ds$bf3 <- (ds$time+1)*I(ds$time > -1)
ds$bf4 <- (ds$time+2)*I(ds$time > 2)
ds$bf5 <- (ds$time+5)*I(ds$time > 5)
ds$bf6 <- (ds$time+8)*I(ds$time > 8)
ds$bf7 <- (ds$time+1)*I(ds$time > 1)
ds$bf8 <- (ds$time+14)*I(ds$time > 14)
ds$Const <- factor(rep(1,length(ds$logp)))

安装模型

library(nlme)
ds <- groupedData(logp ~ time | id, data = ds, order.groups = FALSE)

model <- lme(logp ~ time, data = ds,
              random=list(Const=pdIdent(~-1 + bf1 + bf2 + bf3 + bf4 + bf5 + bf6 + 
                                          bf7 + bf8), id=pdSymm(~time))) 
summary(model)
plot(augPred(model, level=0:1))

我对绘制单个轨迹感兴趣（因此我称之为augPred的原因。但是，结果图如下所示：

这不是我想要的。相反，我可以手动对与ID = 1

对应的数据点进行子集化

plot(fitted(model)[1:24])

这是乏味的，当数据不平衡时不起作用

ds2 = ds[-c(seq(1, 23, 2)),]
model2 <- lme(logp ~ time, data = ds2,
             random=list(Const=pdIdent(~-1 + bf1 + bf2 + bf3 + bf4 + bf5 + bf6 + 
                                         bf7 + bf8), id=pdSymm(~time))) 

plot(fitted(model2)[1:24])

这里我从ID 1中删除了奇数编号的时间点，并且使用相同的代码行，我生成的曲线不再对应于ID 1的个别轨迹。

理想情况下，我只想调用augPred并为每个群集设置一个面板（在这种情况下我的群集是ID），并且在每个面板中我都有固定的轨迹（蓝色）和单独的轨迹（粉红色）（即看起来像这样的东西）

> fm1 <- lme(distance ~ age, data = Orthodont) # random is ~ age
> plot(augPred(fm1, level = 0:1))