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