-
Notifications
You must be signed in to change notification settings - Fork 4
/
opt.longSplinePH.R
41 lines (41 loc) · 1.58 KB
/
opt.longSplinePH.R
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
opt.longSplinePH <-
function (betas) # modified
{
eta.yx <- as.vector(X %*% betas)
if (parameterization %in% c("value", "both")) {
Y <- as.vector(Xtime %*% betas) + Ztime.b
Ys <- as.vector(Xs %*% betas) + Zsb
WintF.vl.alph <- c(WintF.vl %*% alpha)
Ws.intF.vl.alph <- c(Ws.intF.vl %*% alpha)
eta.t <- {
if (is.null(transform.value))
eta.tw2 + eta.tw1 + WintF.vl.alph * Y
else eta.tw2 + eta.tw1 + WintF.vl.alph * transform.value(Y)
}
eta.s <- {
if (is.null(transform.value))
Ws.intF.vl.alph * Ys
else Ws.intF.vl.alph * transform.value(Ys)
}
}
if (parameterization %in% c("slope", "both")) {
Y.deriv <- as.vector(Xtime.deriv %*% betas[indFixed]) + Ztime.b.deriv
Ys.deriv <- as.vector(Xs.deriv %*% betas[indFixed]) + Zsb.deriv
WintF.sl.alph <- c(WintF.sl %*% Dalpha)
Ws.intF.sl.alph <- c(Ws.intF.sl %*% Dalpha)
eta.t <- if (parameterization == "both")
eta.t + WintF.sl.alph * Y.deriv
else eta.tw2 + eta.tw1 + WintF.sl.alph * Y.deriv
eta.s <- if (parameterization == "both")
eta.s + Ws.intF.sl.alph * Ys.deriv
else Ws.intF.sl.alph * Ys.deriv
}
mu.y <- eta.yx + Ztb
logNorm <- dnorm(y, mu.y, sigma, TRUE)
log.p.yb <- rowsum(logNorm, id)
log.hazard <- eta.t
log.survival <- -exp(eta.tw1) * P * rowsum(wk * exp(eta.ws + eta.s), id.GK, reorder = FALSE)
log.p.tb <- rowsum(d * log.hazard + log.survival, idT, reorder = FALSE)
p.bytn <- p.byt * (log.p.yb + log.p.tb)
-sum(p.bytn %*% wGH, na.rm = TRUE)
}