#####
# example with polynomial basis functions
b_func <- function(x){
x <- x - 1
cbind(x^3, x^2, x)
}
g_func <- function(x){
x <- x - 1
cbind(x^3, x^2, x)
}
m_func <- function(x){
x <- x - 1
cbind(x^2, x, 1)
}
# parameters
delta <- c(-.5, -.5, .5)
gamma <- matrix(c(.25, .5, 0, -.4, 0, .3), 3, 2)
omega <- c(1.4, -1.2, -2.1)
Psi <- structure(c(0.18, 0.05, -0.05, 0.1, -0.02, 0.06, 0.05, 0.34, -0.25,
-0.06, -0.03, 0.29, -0.05, -0.25, 0.24, 0.04, 0.04,
-0.12, 0.1, -0.06, 0.04, 0.34, 0, -0.04, -0.02, -0.03,
0.04, 0, 0.1, -0.08, 0.06, 0.29, -0.12, -0.04, -0.08,
0.51), .Dim = c(6L, 6L))
B <- structure(c(-0.57, 0.17, -0.48, 0.58, 1, 0.86), .Dim = 3:2)
sig <- diag(c(.6, .3)^2)
alpha <- c(.5, .9)
# generator functions
r_n_marker <- function(id)
# the number of markers is Poisson distributed
rpois(1, 10) + 1L
r_obs_time <- function(id, n_markes)
# the observations times are uniform distributed
sort(runif(n_markes, 0, 2))
r_z <- function(id)
# return a design matrix for a dummy setup
cbind(1, (id %% 3) == 1, (id %% 3) == 2)
r_x <- r_z # same covariates for the fixed effects
r_left_trunc <- function(id)
# no left-truncation
0
r_right_cens <- function(id)
# right-censoring time is exponentially distributed
rexp(1, rate = .5)
# simulate
gl_dat <- get_gl_rule(30L)
y_max <- 2
n_obs <- 100L
set.seed(1)
dat <- sim_joint_data_set(
n_obs = n_obs, B = B, Psi = Psi, omega = omega, delta = delta,
alpha = alpha, sigma = sig, gamma = gamma, b_func = b_func,
m_func = m_func, g_func = g_func, r_z = r_z, r_left_trunc = r_left_trunc,
r_right_cens = r_right_cens, r_n_marker = r_n_marker, r_x = r_x,
r_obs_time = r_obs_time, y_max = y_max)
# checks
stopifnot(
NROW(dat$survival_data) == n_obs,
NROW(dat$marker_data) >= n_obs,
all(dat$survival_data$y <= y_max))
Run the code above in your browser using DataLab