# NOT RUN {
## An example for a time-varying setup without partial Markov effects:
tra2 <- matrix(ncol = 2, nrow = 2, data = FALSE)
tra2[1, 2] <- tra2[2, 1] <- TRUE
mpl <- mplskeleton(tmat = tra2)
mpl[[1]]$bhr[[2]] <- mpl[[2]]$bhr[[1]] <- function(t){return(0.5)}
mpl[[1]]$eta[[2]] <- function(x.i, t){ ## time-varying x2 and time-varying f(x2)
ifelse(t < 5,
return(1.0 * x.i[1] + 0.5 * x.i[2]),
return(1.0 * x.i[1] + 1.0 * x.i[3]))}
mpl[[2]]$eta[[1]] <- function(x.i, t){ ## time-varying x2 and time-varying f(x1)
ifelse(t < 5,
return(-0.5 * x.i[1] + 0.5 * x.i[2]),
return( 1.0 * x.i[1] + 0.5 * x.i[3]))}
set.seed(123)
N <- 2
X <- matrix(nrow = N, ncol = 2, rnorm(2 * N))
X <- cbind(X, X[, 2] + runif(N)/10)
colnames(X) <- c("x1", "x2.t1", "x2.t2")
Xstruc <- matrix(ncol = 2, nrow = 2, data = 0)
rownames(Xstruc) <- c("t1", "t2")
colnames(Xstruc) <- c("x1", "x2")
Xstruc[, 1] <- 1
Xstruc[, 2] <- c(2, 3)
d <- simeventhistories(n = N, mpl = mpl, X = X, max.time = 10,
change.times = c(5), Xstruc = Xstruc)
head(d$msm.basics)
# }
# NOT RUN {
## An Illness-Death model example with time-varying setup and partial Markov
## effects:
traIDM <- matrix(nrow = 3, ncol = 3, FALSE)
traIDM[1, 2] <- traIDM[1, 3] <- traIDM[2, 1] <- traIDM[2, 3] <- TRUE
mpl <- mplskeleton(tmat = traIDM)
mpl[[1]]$bhr[[2]] <- mpl[[1]]$bhr[[3]] <- mpl[[2]]$bhr[[1]] <-
mpl[[2]]$bhr[[3]] <- function(t){0.25}
mpl[[1]]$eta[[2]] <- mpl[[1]]$eta[[3]] <- mpl[[2]]$eta[[1]] <-
mpl[[2]]$eta[[3]] <- function(x.i, t){
ifelse(t < 5,
return(0.5 * x.i[1]),
return(0.5 * x.i[2]))}
set.seed(123)
N <- 500
X <- matrix(nrow = N, ncol = 1, rnorm(N))
X <- cbind(X, X[, 1] + rnorm(N)/10)
colnames(X) <- c("x1.t1", "x1.t2")
Xstruc <- matrix(ncol = 1, nrow = 2, data = 0)
rownames(Xstruc) <- c("t1", "t2")
colnames(Xstruc) <- c("x1")
Xstruc[, 1] <- c(1, 2)
Xstruc
## Now set-up the partial Markov influences:
## Function 'partial.markov.x' has to take 5 input arguments representig vectors
## of past history information. They have to take names 'entry', 'exit', 'from',
## 'to', and 'delta':
partial.markov.x <- function(entry, exit, from, to, delta){
count.12 <- sum(as.numeric((from == 1) & (to == 2) & (delta == 1)))
count.21 <- sum(as.numeric((from == 2) & (to == 1) & (delta == 1)))
return(c(count.12, count.21))}
## List 'partial.markov.eta' is a list of lists in analogy to 'mpl':
partial.markov.eta <- pmeskeleton(traIDM)
partial.markov.eta[[1]][[2]] <- function(x){return( 0.25 * x[1])}
partial.markov.eta[[1]][[3]] <- function(x){return( 0.50 * x[1])}
partial.markov.eta[[2]][[1]] <- function(x){return(-0.50 * x[1] + 0.25 * x[2])}
partial.markov.eta[[2]][[3]] <- function(x){return(0)}
## Event history simulation:
d <- simeventhistories(n = N, mpl = mpl, X = X, max.time = 10,
change.times = c(5), Xstruc = Xstruc,
partial.markov.x = partial.markov.x,
partial.markov.eta = partial.markov.eta)
# }
Run the code above in your browser using DataLab