Update to Graphing Non-Proportional Hazards in R

[This article was first published on Christopher Gandrud (간드루드 크리스토파), and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.


Update 1 February 2013: I’ve moved all of the functionality described in this post into an R package called simtvc. Have a look. It is much easier to use.


This is a quick update for a previous post on Graphing Non-Proportional Hazards in R.

In the previous post I showed how to simulate and graph 1,000 non-proportional hazard ratios at roughly every point in time across an observation period. In the previous example I kept in simulation outliers. Some people have suggested dropping the top and bottom 2.5 percent of simulated values (i.e. keeping the middle 95 percent).

Luckily this can be accomplished with Hadley Wickham‘s plyr package and three lines of code. The trick is to use plyr’s ddply command to subset the data frame at each point in Time where we simulated values. In the previous example the simulated values were in a variable called HRqmv. In each subset we use the quantile command from base R to create logical variables indicating if a simulation of HRqmv is greater than the 0.975 or less than the 0.025 quantile. Then we simply subset the data frame.

Here’s how you do it: after all of the values have been simulated and the data set ordered and right before graphing the results add this code:

# Indicate bottom 2.5% of observations
TVSimPerc <- ddply(TVSim, .(Time), transform, Lower = HRqmv < quantile(HRqmv, c(0.025)))

# Indicate top 2.5% of observations
TVSimPerc <- ddply(TVSimPerc, .(Time), transform, Upper = HRqmv > quantile(HRqmv, c(0.975)))

# Drop simulations outside of the middle 95%
TVSimPerc <- subset(TVSimPerc, Lower == FALSE & Upper == FALSE)

Adding this code to the previous example creates this graph:

Here is the full code to replicate the example:

#################
# Use R to recreate part of QMV the relative non-proportional hazard estimation graph (fig 2) from Licht (2011)
# Updated to keep only the middle 95% of simulations
# Christopher Gandrud (http://christophergandrud.blogspot.com/)
# 30 December 2012
#################
#### Set Up ####
# Load required libraries
library(survival)
library(MSBVAR)
library(reshape)
library(reshape2)
library(ggplot2)
# Load Golub & Steunenberg (2007) Data
## Originally downloaded from http://hdl.handle.net/1902.1/15633
GS <- read.table("GolubEUPdata.tab", header = TRUE)
# Create log time variable
GS$LT <- log(GS$end)
# Create natural log time interactions
attach(GS)
GS$Lqmv <- LT * qmv
GS$Lqmvpostsea <- LT * qmvpostsea
GS$Lcoop <- LT * coop
GS$Lcodec <- LT * codec
GS$Lthatcher <- LT * thatcher
GS$Lbacklog <- LT * backlog
detach(GS)
#### Run Cox PH Model ####
# Note, this model does not exactly match Licht (2011), but is pretty close
M1 <- coxph(Surv(begin, end, event) ~
qmv + qmvpostsea + qmvpostteu +
coop + codec + eu9 + eu10 + eu12 +
eu15 + thatcher + agenda + backlog +
Lqmv + Lqmvpostsea + Lcoop + Lcodec +
Lthatcher + Lbacklog,
data = GS,
ties = "efron")
#### Simulate Relative Hazards ####
# Create coefficient matrix
Coef <- matrix(M1$coefficients)
# Create variance-covariance matrix
VC <- vcov(M1)
# Simulate Using MSBVAR
Drawn <- rmultnorm(n = 1000, mu = Coef, vmat = VC)
#### Create Combined Coefficient ####
# Keep qmv and Lqmv
Drawn <- data.frame(Drawn[, c(1, 13)])
# Create Merge Variable (Simulation Number)
Drawn$ID <- 1:1000
# Create range of years over which the combined coefficient will be created
Range <- log(seq(from = 80, to = 2000, by = 15))
# Create Combined time interactionsCoefficient
TVSim <- outer(Drawn[,2], Range)
TVSim <- data.frame(melt(TVSim))
TVSim <- rename(TVSim, c(X1 = "ID", X2 = "Time", value = "TVR"))
# Merge in the non-time interacted coefficient and combine
TVSim <- merge(Drawn, TVSim, by = "ID")
TVSim$CCqmv <- TVSim$qmv + TVSim$TVR
#### Create Combined Relative Hazard ####
TVSim$HRqmv <- exp(TVSim$CCqmv)
# Order Variables by time
TVSim <- TVSim[order(TVSim$Time),]
# Drop bottom 2.5% of observations
TVSimPerc <- ddply(TVSim, .(Time), transform, Lower = HRqmv < quantile(HRqmv, c(0.025)))
# Drop top 2.5% of observations
TVSimPerc <- ddply(TVSimPerc, .(Time), transform, Upper = HRqmv > quantile(HRqmv, c(0.975)))
# Remove variables outside of the middle 95%
TVSimPerc <- subset(TVSimPerc, Lower == FALSE & Upper == FALSE)
#### Graph Simulated Combined Hazard Ratios ####
ggplot(TVSimPerc, aes(Time, HRqmv)) +
geom_point(shape = 21, alpha = I(0.01), colour = "#FA9FB5", size = 5) +
geom_smooth() +
geom_hline(aes(yintercept = 1), linetype = "dotted") +
scale_y_continuous(breaks = c(-1, 0, 1, 3, 6)) +
scale_x_continuous(breaks = c(0, 129), labels = c(80, 2000)) +
xlab("Time in Days") + ylab("Simulated QMV Relative Hazard\n") +
ggtitle("Simulated Relative Hazard for QMV from times 80-2000, middle 95%\n") +
theme_bw(base_size = 15)
view raw Middle95HR.R hosted with ❤ by GitHub

To leave a comment for the author, please follow the link and comment on their blog: Christopher Gandrud (간드루드 크리스토파).

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)