examples/ch3.R

In tagteam/MedicalRiskPredictionModels: R-codes for book: Medical Risk Prediction Models by Gerds & kattan

library(MedicalRiskPredictionModels)
prepareExamples()

# Chunk1
library(Publish)
library(data.table)
data(Diabetes)
Diabetes[1:5,c("weight","height")]

# Chunk2
Diabetes$height.m <-  Diabetes$height*0.0254
Diabetes$weight.kg <-  Diabetes$weight*0.4535929
Diabetes$bmi <-  Diabetes$weight.kg/Diabetes$height.m^2
Diabetes$BMI <- cut(Diabetes$bmi,c(0,18,25,30,Inf),labels=c("UnderWeight","NormalWeight","OverWeight","Obese"))
Diabetes[,c("weight","height","bmi","BMI")]

# Chunk3
library(data.table)
setDT(long)
long <- long[,list("psa.time"=psadate-psadate[1],psadate,psa),by=subject]
long <- long[psa.time<=(2*365.25),]
# psa doubling time formula
psadt <- function(time,value){ # input date and psa value
  (log(2)/coef(lm(log(value)~time))[2])/365.25 # lm is linear model
}
# now apply function to individual subjects
long[,list("psa.doublingtime"=psadt(psa.time,psa)),by=subject]

# Chunk4 (no competing risks)
library(data.table)
d$af.date <- as.Date(d$af.date)
d$death.date <- as.Date(d$death.date)
d$lost.date <- as.Date(d$lost.date)
d$time <- pmin(  # parallel minimum
     d$death.date, # event 
     d$lost.date,  # lost to follow up
     as.Date("2015-01-01") # administrative censoring
    ,na.rm=TRUE)-d$af.date # date of subject specific time origin
d$event <- 0 # initialize all subjects
d[!is.na(d$death.date),]$event <- 1 # event 
d

# Chunk5 (with competing risks)
library(data.table)
d$af.date <- as.Date(d$af.date)
d$stroke.date <- as.Date(d$stroke.date)
d$death.date <- as.Date(d$death.date)
d$lost.date <- as.Date(d$lost.date)
d$time <- pmin(  # parallel minimum
  d$stroke.date, # event 
  d$death.date,  # competing risk 
  d$lost.date,   # lost to follow up
  as.Date("2015-01-01") # administrative censoring
 ,na.rm=TRUE) -d$af.date # date of subject specific time origin
d$event <- 0 # initialize all subjects
d[!is.na(d$stroke.date),]$event <- 1 # event 
d[!is.na(d$death.date) & is.na(d$stroke.date),]$event <- 2 # competing
d

# Chunk6
library(data.table)
d$time.5 <- pmin(d$time,5*365.25)
d$event.5 <- d$event
d[d$time>5*365.25,]$event.5 <- 0
d[,c("time","event","time.5","event.5")]