In Big-Life-Lab/bllflow: Big Life Lab Flow - a Workflow for Predictive Studies

library(survival) #pcb data
library(cmprsk) #crr function
library(rms) #rcs function

data(pbc)

Overview

Here I am going to show an example of using the primary billary cirrhosis (PBC) data to create a Fine and Grey regression model to evalute the effect of treatment with Dpenicillamine (trt) on time to transpantion (time), considering death as a competing risk (status).

Age will be modelled as a restricted cubic spline with 5 knots (requires the Hmic package), and bilirubin as an rcs with 3 knots.

Only include the patients invovled in the randomized trial:

pbc <- pbc[!is.na(pbc$trt),]

Prepare the data

First we need to change sex from 'm' and 'f' to '0' and '1'

attach(pbc)
pbc$sex <- ifelse(sex == 'm', 0,
            ifelse(sex == 'f', 1, NA))
detach(pbc)

Next we want to find the means and center the variables

attach(pbc)
trt_mean <- signif(mean(trt), 3)
sex_mean <- signif(mean(sex), 3)
age_mean <- signif(mean(age), 3)
bili_mean <- signif(mean(bili), 3)
detach(pbc)

Center on the means

attach(pbc)
pbc$trtC <- trt - trt_mean
pbc$sexC <- sex - sex_mean
pbc$ageC <- age - age_mean
pbc$biliC <- bili - bili_mean
detach(pbc)

Create restricted cubic spline variables for age

A k knot spline is specified by k-1 variables. For example, a five knot spline is specified by 4 variables. The first variable is always the same as the original variable.

The rcs function creates variables are named by adding ' to the end of the original variable name. These names are difficult to work with and do not fit our naming scheme. For example, this code this will create the four variables needed for a 5 knot cubic spline of age: age (the original variable), age', age'', and age''':

attach(pbc)
age_rcs_vec <- rcs(ageC, 5)
bili_rcs_vec <- rcs(biliC, 5)
detach(pbc)

I have modified the rcs function from Harrell's rms package to let us specify the names of the resulting rcs variables.

source(file.path(getwd(), "../R/rcs2.R"))
age_rcs_vec2 <- rcs2(pbc$ageC, 5, rcs_names = c("AgeC_rcs1", "AgeC_rcs2", "AgeC_rcs3", "AgeC_rcs4"))
bili_rcs_vec2 <- rcs2(pbc$biliC, 3, rcs_names = c("BiliC_rcs1", "BiliC_rcs2"))

Use the rcs funciton to collect all of the variables you want to use in the model into a single object for easier regression running.

attach(pbc)
allvars <- as.data.frame(cbind(trtC, sexC, age_rcs_vec2, bili_rcs_vec2))
detach(pbc)
str(allvars)

The allvars object contains 8 variables.

Create the Fine and Grey regression model

The 'time' variable is the time (in days) from study start to either censoring, liver transplantation, or death The 'status' variable is 0 for censored, 1 for transplant, 2 for death

pbc_crr_model <- crr(ftime = pbc$time, fstatus = pbc$status, allvars, failcode = 1, cencode = 0)
summary(pbc_crr_model)

The beta coefficients for the model are here:

pbc_crr_model$coef

Baseline Risk of Event

We also need to know the baseline risk (1- cumualtive incidence) of the event at time t. Here I will show how to obtain baseline risk of transplant at 2 years

Function for calcualting baseline risk:

baseline.risk <- function(model, time) {
  jumps <- data.frame(time = model$uftime, bfitj = model$bfitj)
  jumps_time <- jumps[jumps$time <= time, ]
  b0 <- sum(jumps_time$bfitj)
  out <- 1-exp(-b0)
  return(out)
}

Baseline risk at 2 years

H0_2YR <- baseline.risk(pbc_crr_model, (365.25*2))
H0_2YR

r H0_2YR*100% of average individuals receive transplant within 2 years

Knot locations

We need to know where the knots are placed. To determine this:

attributes(rcspline.eval(pbc$ageC, nk = 5))$knots
attributes(rcspline.eval(pbc$biliC, nk = 3))$knots

Or,

attributes(age_rcs_vec2)$parms
attributes(bili_rcs_vec2)$parms

TODO: when we create the RCS function, we'll need to have an argument that passess the bllflow modelObject. Then add these knots to that object.

model_pbc_table_one <- tableone::CreateTableOne(data = allvars, vars = c("trtC", "sexC", "AgeC_rcs1", "AgeC_rcs2", "AgeC_rcs3", "AgeC_rcs4", "BiliC_rcs1", "BiliC_rcs2"))

library(bllflow)
bllModel <- create_BLLModel_object(allvars, pbc_crr_model, model_pbc_table_one)
bllModel$reference
bllModel$baseline

Generate a bllflow model object

This object is used to generate the PMML file, for manuscript figures and other uses.

@param model_object The object that is returned when a model is created. @param model_type values = crr, NULL. The class name of the modelObject. "crr" is the class name for the Fine and Grey model. This is currently the only model that is supported. @param table_one The object returned by createTableOne(). @param model_data The data used to generate the model. @param calculate_mean default = TRUE. If TRUE and table_one = missing, then calculate means of variables.

pbcTableOne = create_table_one(data = pbc)
bllModel <- create_BLLModel_object(modelObject = pbc_crr_model, tableOne = pbcTableOne, modelData = allvars)
bllModel$reference
bllModel$baseline

Note that model_type is missing in this call. The function should examine class of pbc_crr_model. If class <> 'crr' the issue error "Not a recognized model (allowable models include: crr)".

Big-Life-Lab/bllflow documentation built on Feb. 1, 2023, 12:29 p.m.