1### Some useful miscellaneous functions ###
2
3tra_ill <- function(state.names = c("0", "1", "2")) {
4
5    if (length(state.names) != 3)
6        stop("An illness-death model has 3 states")
7
8    tra <- matrix(FALSE, ncol = 3, nrow = 3,
9                  dimnames = list(state.names, state.names))
10    tra[1, 2:3] <- TRUE
11    tra[2, 3] <- TRUE
12    tra
13}
14
15tra_ill_comp <- function(nComp = 2,
16                         state.names = as.character(seq(0, nComp + 1, 1))) {
17
18    if (nComp == 1)
19        stop("No competing risks. Use 'tra_ill' instead")
20
21    nstates <- length(state.names)
22    if (length(state.names) != nComp + 2)
23        stop(paste("Something is wrong with 'state.names'. The specified multistate model has ",
24                   nComp + 2L, " states", sep = ""))
25
26    tra <- matrix(FALSE, nstates, nstates,
27                  dimnames = list(state.names, state.names))
28    tra[1, 2:nstates] <- TRUE
29    tra[2, 3:nstates] <- TRUE
30    tra
31}
32
33tra_comp <- function(nComp = 2,
34                     state.names = as.character(seq(0, nComp))) {
35
36    if (nComp == 1)
37        stop("That's not a competing risks model. Use 'tra_surv' instead")
38    nstates <- length(state.names)
39    if (nstates != nComp + 1L)
40        stop(paste("Something is wrong with 'state.names'. The specified multistate model has ",
41                   nComp + 1L, " states", sep = ""))
42
43    tra <- matrix(FALSE, nstates, nstates,
44                  dimnames = list(state.names, state.names))
45    tra[1, 2:nstates] <- TRUE
46    tra
47}
48
49tra_surv <- function(state.names = c("0", "1")) {
50
51    if (length(state.names) != 2)
52        stop("Survival model has 2 states")
53
54    tra <- matrix(FALSE, ncol = 2, nrow = 2,
55                  dimnames = list(state.names, state.names))
56    tra[1, 2] <- TRUE
57    tra
58}
59
60### A little function that transform the data from time to entry exit
61transfo_to_counting <- function(df) {
62
63    if (!("data.table" %in% class(df)))
64        stop("The data should be of class 'data.table'")
65
66    setorder(df, id, time)
67    df[, idd := as.integer(id)]
68    df[, masque := rbind(1, apply(as.matrix(idd), 2, diff))]
69    df[, entree := c(0, time[1:(length(time) - 1)]) * (masque == 0)]
70    df[, ':='(entry = entree,
71              exit = time,
72              entree = NULL,
73              time = NULL,
74              masque = NULL)]
75
76    return(df)
77}
78
79### Product integration
80prodint <- function(dna, times, first, last, indi) {
81    I <- array(0, dim=dim(dna)[c(1, 2)])
82    diag(I) <- 1
83    if (first >= last) {
84        est <- array(I, dim=c(dim(dna)[c(1, 2)], 1))
85        time <- NULL
86    } else {
87        est <- array(0, dim=c(dim(dna)[c(1, 2)], (last-first+1)))
88        est[, , 1] <- I + dna[, , first] * indi[1]
89        j <- 2
90        for (i in (first + 1):last) {
91            est[, , j] <- est[, , j-1] %*% (I + dna[, , i] * indi[j])
92            j <- j + 1
93        }
94        time <- times[first:last]
95    }
96    list(est=est, time=time)
97}
98
99