Hazard Function

The hazard function plots require the visreg package.

To illustrate hazard function plots, we will use the breast cancer dataset which contains the observations of 686 women taken from the TH.data package. This dataset is also available from the casebase package. In the following, we will show different hazard functions for different combinations of continuous, binary variables as well as their interactions.

library(casebase)
library(visreg)
library(splines)
library(ggplot2)
data("brcancer")
str(brcancer)

One binary predictor, no interactions

We first fit a main effects only model with a spline on log(time) and hormonal therapy as main effects.

mod_cb <- fitSmoothHazard(cens ~ ns(log(time), df = 3) + hormon,
                          data = brcancer,
                          time = "time")
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(mod_cb)
#> 
#> Call:
#> glm(formula = formula, family = binomial, data = sampleData)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.1802  -0.1589  -0.1493  -0.1252   3.8443  
#> 
#> Coefficients:
#>                        Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)            -66.6516    14.1663  -4.705 2.54e-06 ***
#> ns(log(time), df = 3)1  39.3469     9.2854   4.238 2.26e-05 ***
#> ns(log(time), df = 3)2 113.8840    27.6210   4.123 3.74e-05 ***
#> ns(log(time), df = 3)3  23.4631     5.6315   4.166 3.09e-05 ***
#> hormon                  -0.3629     0.1256  -2.890  0.00386 ** 
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 3354.9  on 30198  degrees of freedom
#> Residual deviance: 3278.0  on 30194  degrees of freedom
#> AIC: 3288
#> 
#> Number of Fisher Scoring iterations: 10

Hazard functions on separate plots

All arguments needed for the hazard function plots are supplied through the hazard.params argument. This is a named list of arguments which will override the defaults passed to visreg::visreg(). The default arguments are list(fit = x, trans = exp, plot = TRUE, rug = FALSE, alpha = 1, partial = FALSE, overlay = TRUE). For example, if you want a 95% confidence band, specify hazard.params = list(alpha = 0.05). For a complete list of options, please see the visreg vignettes.

We first plot the hazard as a function of time, for hormon = 0 and hormon = 1. This is achieved by specifying the xvar argument, as well as the cond argument. The cond argument must be provided as a named list. Each element of that list specifies the value for one of the terms in the model; any elements left unspecified are filled in with the median/most common category. Note that even though we fit the log(time), we must specify time in the xvar argument.

par(mfrow = c(1, 2))
plot(mod_cb,
     hazard.params = list(xvar = "time",
                          cond = list(hormon = 0),
                          alpha = 0.05,
                          main = "No Hormonal Therapy Hazard Function"))

plot(mod_cb,
     hazard.params = list(xvar = "time",
                          cond = list(hormon = 1),
                          alpha = 0.05,
                          main = "Hormonal Therapy Hazard Function"))

Hazard functions on same plots

Alternatively, we can plot the hazard functions on the same plot. This is accomplished with the by argument:

plot(mod_cb,
     hazard.params = list(xvar = "time",
                          by = "hormon",
                          alpha = 0.05,
                          ylab = "Hazard"))

Note that if we want to extract the data used to construct the plot, e.g. to create our own, we simply assign the call to plot to an object (we may optionally set plot=FALSE in the hazard.params argument as to not print any plots):

plot_results <- plot(mod_cb,
     hazard.params = list(xvar = "time",
                          by = "hormon",
                          alpha = 0.10,
                          ylab = "Hazard",
                          plot = FALSE))

head(plot_results$fit)
#>           time hormon offset cens    visregFit    visregLwr    visregUpr
#> 1   0.05341138      0      0    0 1.131340e-29 8.587843e-40 1.490397e-19
#> 2  25.93592327      0      0    0 2.694254e-07 1.659938e-08 4.373059e-06
#> 3  51.81843516      0      0    0 6.813619e-06 1.435501e-06 3.234090e-05
#> 4  77.70094705      0      0    0 3.122054e-05 1.152440e-05 8.457905e-05
#> 5 103.58345894      0      0    0 7.708507e-05 3.914608e-05 1.517932e-04
#> 6 129.46597083      0      0    0 1.399014e-04 8.654666e-05 2.261485e-04

ggplot2 version

The function is flexible because you may leverage ggplot2 just by specifying gg = TRUE, the plot will return a ggplot object:

gg_object <- plot(mod_cb,
                  hazard.params = list(xvar = "time",
                                       by = "hormon",
                                       alpha = 0.20, # 80% CI
                                       ylab = "Hazard",
                                       gg = TRUE))

attr(gg_object,"class")
#> [1] "gg"     "ggplot"

Now we can use it downstream for any plot while leveraging the entire ggplot2 ecosystem of packages and functions:

gg_object + 
  theme_minimal()+
  theme(legend.position = "bottom") + 
  labs(title = "Casebase") +
  scale_x_continuous(n.breaks = 10)

One binary predictor with interaction

Next, we fit an interaction model with a time-varying covariate, i.e. to test the hypothesis that the effect of hormonal therapy on the hazard varies with time.

mod_cb_tvc <- fitSmoothHazard(cens ~ hormon * ns(log(time), df = 3),
                              data = brcancer,
                              time = "time")
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(mod_cb_tvc)
#> 
#> Call:
#> glm(formula = formula, family = binomial, data = sampleData)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.1818  -0.1599  -0.1454  -0.1264   3.7822  
#> 
#> Coefficients:
#>                               Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)                    -83.584     22.085  -3.785 0.000154 ***
#> hormon                         -31.467     49.508  -0.636 0.525037    
#> ns(log(time), df = 3)1          50.860     14.550   3.496 0.000473 ***
#> ns(log(time), df = 3)2         146.159     42.961   3.402 0.000669 ***
#> ns(log(time), df = 3)3          30.266      8.819   3.432 0.000599 ***
#> hormon:ns(log(time), df = 3)1   20.911     32.826   0.637 0.524115    
#> hormon:ns(log(time), df = 3)2   59.743     95.878   0.623 0.533210    
#> hormon:ns(log(time), df = 3)3   12.946     19.877   0.651 0.514861    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 3354.9  on 30198  degrees of freedom
#> Residual deviance: 3273.0  on 30191  degrees of freedom
#> AIC: 3289
#> 
#> Number of Fisher Scoring iterations: 11

Now we can easily plot the hazard function over time for each hormon group:

plot(mod_cb_tvc,
     hazard.params = list(xvar = "time",
                          by = "hormon",
                          alpha = 0.05,
                          ylab = "Hazard"))

One continuous predictor with interaction

Now we fit a model with an interaction between a continuous variable, estrogen receptor (in fmol), and time.

mod_cb_tvc <- fitSmoothHazard(cens ~ estrec * ns(log(time), df = 3),
                              data = brcancer,
                              time = "time")
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(mod_cb_tvc)
#> 
#> Call:
#> glm(formula = formula, family = binomial, data = sampleData)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.1895  -0.1610  -0.1420  -0.1358   4.0329  
#> 
#> Coefficients:
#>                               Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)                   -70.9573    18.8668  -3.761 0.000169 ***
#> estrec                         -0.6200     0.3444  -1.800 0.071854 .  
#> ns(log(time), df = 3)1         41.5050    12.3820   3.352 0.000802 ***
#> ns(log(time), df = 3)2        123.2372    36.7392   3.354 0.000795 ***
#> ns(log(time), df = 3)3         24.4522     7.5337   3.246 0.001172 ** 
#> estrec:ns(log(time), df = 3)1   0.4245     0.2310   1.837 0.066151 .  
#> estrec:ns(log(time), df = 3)2   1.1707     0.6608   1.772 0.076457 .  
#> estrec:ns(log(time), df = 3)3   0.2638     0.1417   1.861 0.062682 .  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 3354.9  on 30198  degrees of freedom
#> Residual deviance: 3261.6  on 30191  degrees of freedom
#> AIC: 3277.6
#> 
#> Number of Fisher Scoring iterations: 13

There are now many ways to plot the time-varying effect of estrogen receptor on the hazard function. The default is to plot the 10th, 50th and 90th quantiles of the by variable:

# computed at the 10th, 50th and 90th quantiles of estrec
plot(mod_cb_tvc,
     hazard.params = list(xvar = "time",
                          by = "estrec",
                          alpha = 1,
                          ylab = "Hazard"))

We can also show the quartiles of estrec by specifying the breaks argument. If breaks is a single number, that will be the used as the number of breaks:

# computed at quartiles of estrec
plot(mod_cb_tvc,
     hazard.params = list(xvar = c("time"),
                          by = "estrec",
                          alpha = 1,
                          breaks = 4,
                          ylab = "Hazard"))

Alternatively, if breaks is a vector, it will be used as the actual values to be used:

# computed where I want
plot(mod_cb_tvc,
     hazard.params = list(xvar = c("time"),
                          by = "estrec",
                          alpha = 1,
                          breaks = c(3,2200),
                          ylab = "Hazard"))

Image and Perspective Plots

Instead of taking a cross-section of the effect of estrec on the hazard, we can plot a surface using the visreg2d function:

visreg2d(mod_cb_tvc, 
         xvar = "time",
         yvar = "estrec",
         trans = exp,
         print.cond = TRUE,
         zlab = "Hazard",
         plot.type = "image")


visreg2d(mod_cb_tvc, 
         xvar = "time",
         yvar = "estrec",
         trans = exp,
         print.cond = TRUE,
         zlab = "Hazard",
         plot.type = "persp")


# this can also work if 'rgl' is installed
# visreg2d(mod_cb_tvc, 
#          xvar = "time",
#          yvar = "estrec",
#          trans = exp,
#          print.cond = TRUE,
#          zlab = "Hazard",
#          plot.type = "rgl")

One continuous predictor with interaction and several other predictors

All the examples so far have only included two predictors in the regression equation. In this example, we fit a smooth hazard model with several predictors:

mod_cb_tvc <- fitSmoothHazard(cens ~ estrec * ns(log(time), df = 3) + 
                                horTh + 
                                age + 
                                menostat + 
                                tsize + 
                                tgrade + 
                                pnodes + 
                                progrec,
                              data = brcancer,
                              time = "time")
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(mod_cb_tvc)
#> 
#> Call:
#> glm(formula = formula, family = binomial, data = sampleData)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.7032  -0.1617  -0.1336  -0.0955   4.0757  
#> 
#> Coefficients:
#>                                 Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)                   -6.591e+01  1.754e+01  -3.758 0.000171 ***
#> estrec                        -4.856e-01  3.050e-01  -1.592 0.111330    
#> ns(log(time), df = 3)1         3.818e+01  1.146e+01   3.332 0.000864 ***
#> ns(log(time), df = 3)2         1.130e+02  3.418e+01   3.306 0.000945 ***
#> ns(log(time), df = 3)3         2.314e+01  7.030e+00   3.292 0.000994 ***
#> horThyes                      -3.487e-01  1.302e-01  -2.679 0.007388 ** 
#> age                           -9.146e-03  9.295e-03  -0.984 0.325172    
#> menostatPost                   2.865e-01  1.847e-01   1.551 0.120900    
#> tsize                          7.236e-03  3.963e-03   1.826 0.067830 .  
#> tgrade.L                       5.386e-01  1.908e-01   2.823 0.004765 ** 
#> tgrade.Q                      -2.223e-01  1.224e-01  -1.815 0.069454 .  
#> pnodes                         5.418e-02  8.066e-03   6.717 1.85e-11 ***
#> progrec                       -2.244e-03  5.762e-04  -3.894 9.84e-05 ***
#> estrec:ns(log(time), df = 3)1  3.331e-01  2.040e-01   1.633 0.102488    
#> estrec:ns(log(time), df = 3)2  9.179e-01  5.851e-01   1.569 0.116718    
#> estrec:ns(log(time), df = 3)3  2.083e-01  1.260e-01   1.653 0.098405 .  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 3354.9  on 30198  degrees of freedom
#> Residual deviance: 3163.7  on 30183  degrees of freedom
#> AIC: 3195.7
#> 
#> Number of Fisher Scoring iterations: 13

In the following plot, we show the time-varying effect of estrec while controlling for all other variables. By default, the other terms in the model are set to their median if the term is numeric or the most common category if the term is a factor. The values of the other variables are shown in the output:

plot(mod_cb_tvc,
     hazard.params = list(xvar = "time",
                          by = "estrec",
                          alpha = 1,
                          breaks = 2,
                          ylab = "Hazard"))
#> Conditions used in construction of plot
#> estrec: 8 / 175
#> horTh: no
#> age: 53
#> menostat: Post
#> tsize: 25
#> tgrade: II
#> pnodes: 3
#> progrec: 48
#> offset: 0

#> $fit
#>      estrec time horTh age menostat tsize tgrade pnodes progrec offset cens
#>      visregFit visregLwr visregUpr
#>  [ reached 'max' / getOption("max.print") -- omitted 202 rows ]
#> 
#>  [ reached getOption("max.print") -- omitted 2 entries ]
#> attr(,"class")
#> [1] "visreg"

You can of course set the values of the other covariates as before, i.e. by specifying the cond argument as a named list to the hazard.params argument:

plot(mod_cb_tvc,
     hazard.params = list(xvar = "time",
                          by = "estrec",
                          cond = list(tgrade = "III", age = 49),
                          alpha = 1,
                          breaks = 2,
                          ylab = "Hazard"))
#> Conditions used in construction of plot
#> estrec: 8 / 175
#> horTh: no
#> age: 49
#> menostat: Post
#> tsize: 25
#> tgrade: III
#> pnodes: 3
#> progrec: 48
#> offset: 0

#> $fit
#>      estrec time horTh age menostat tsize tgrade pnodes progrec offset cens
#>      visregFit visregLwr visregUpr
#>  [ reached 'max' / getOption("max.print") -- omitted 202 rows ]
#> 
#>  [ reached getOption("max.print") -- omitted 2 entries ]
#> attr(,"class")
#> [1] "visreg"

Hazard Ratio

In this section we illustrate how to plot hazard ratios using the plot method for objects of class singleEventCB which is obtained from running the fitSmoothHazard function. Note that these function have only been thoroughly tested with family = "glm".

In what follows, the hazard ratio for a variable \(X\) is defined as

\[ \frac{h\left(t | X=x_1, \mathbf{Z}=\mathbf{z_1} ; \hat{\beta}\right)}{h(t | X=x_0, \mathbf{Z}=\mathbf{z_0} ; \hat{\beta})} \] where \(h(t|\cdot;\hat{\beta})\) is the hazard rate as a function of the variable \(t\) (which is usually time, but can be any other continuous variable), \(x_1\) is the value of \(X\) for the exposed group, \(x_0\) is the value of \(X\) for the unexposed group, \(\mathbf{Z}\) are other covariates in the model which are equal to \(\mathbf{z_1}\) in the exposed and \(\mathbf{z_0}\) in the unexposed group, and \(\hat{\beta}\) are the estimated regression coefficients.

As indicated by the formula above, it is most instructive to plot the hazard ratio as a function of a variable \(t\) only if there is an interaction between \(t\) and \(X\). Otherwise, the resulting plot will simply be a horizontal line across time.

Manson Trial (eprchd)

We use data from the Manson trial (NEJM 2003) which is included in the casebase package. This randomized clinical trial investigated the effect of estrogen plus progestin (estPro) on coronary heart disease (CHD) risk in 16,608 postmenopausal women who were 50 to 79 years of age at base line. Participants were randomly assigned to receive estPro or placebo. The primary efficacy outcome of the trial was CHD (nonfatal myocardial infarction or death due to CHD).

We fit a model with the interaction between time and treatment arm. We are therefore interested in visualizing the hazard ratio of the treatment over time.

data("eprchd")
eprchd <- transform(eprchd, 
                    treatment = factor(treatment, levels = c("placebo","estPro")))
str(eprchd)
#> 'data.frame':    16608 obs. of  3 variables:
#>  $ time     : num  0.0833 0.0833 0.0833 0.0833 0.0833 ...
#>  $ status   : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ treatment: Factor w/ 2 levels "placebo","estPro": 1 1 1 1 1 1 1 1 1 1 ...

fit_mason <- fitSmoothHazard(status ~ treatment*time,
                             data = eprchd,
                             time = "time")
summary(fit_mason)
#> 
#> Call:
#> glm(formula = formula, family = binomial, data = sampleData)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.1648  -0.1493  -0.1462  -0.1310   3.1790  
#> 
#> Coefficients:
#>                      Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)          -6.08226    0.17462 -34.831  < 2e-16 ***
#> treatmentestPro       0.59757    0.22352   2.673  0.00751 ** 
#> time                  0.10909    0.04742   2.300  0.02143 *  
#> treatmentestPro:time -0.12467    0.06313  -1.975  0.04829 *  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 3635.4  on 32723  degrees of freedom
#> Residual deviance: 3626.1  on 32720  degrees of freedom
#> AIC: 3634.1
#> 
#> Number of Fisher Scoring iterations: 7

To plot the hazard ratio, we must specify the newdata argument with a covariate pattern for the reference group. In this example, we treat the placebo as the reference group. Because we have fit an interaction with time, we also provide a sequence of times at which we would like to calculate the hazard ratio.

newtime <- quantile(fit_mason[["originalData"]][[fit_mason[["timeVar"]]]], 
                    probs = seq(0.01, 0.99, 0.01))

# reference category
newdata <- data.frame(treatment = factor("placebo", 
                                         levels = c("placebo", "estPro")), 
                      time = newtime)
str(newdata)
#> 'data.frame':    99 obs. of  2 variables:
#>  $ treatment: Factor w/ 2 levels "placebo","estPro": 1 1 1 1 1 1 1 1 1 1 ...
#>  $ time     : num  0.917 1.75 2.5 3.167 3.417 ...

plot(fit_mason, 
     type = "hr", 
     newdata = newdata,
     var = "treatment",
     increment = 1,
     xvar = "time",
     ci = T,
     rug = T)

In the call to plot we specify the xvar which is the variable plotted on the x-axis, the var argument which specified the variable for which we want the hazard ratio. The increment = 1 indicates that we want to increment var by 1 level, which in this case is estPro. Alternatively, we can specify the exposed argument which should be a function that takes newdata and returns the exposed dataset. The following call is equivalent to the one above:

plot(fit_mason, 
     type = "hr", 
     newdata = newdata,
     exposed = function(data) transform(data, treatment = "estPro"),
     xvar = "time",
     ci = T,
     rug = T)

Alternatively, if we want the placebo group to be the exposed group, we can change the newdata argument to the following:

newdata <- data.frame(treatment = factor("estPro", 
                                         levels = c("placebo", "estPro")), 
                      time = newtime)
str(newdata)
#> 'data.frame':    99 obs. of  2 variables:
#>  $ treatment: Factor w/ 2 levels "placebo","estPro": 2 2 2 2 2 2 2 2 2 2 ...
#>  $ time     : num  0.917 1.75 2.5 3.167 3.417 ...

levels(newdata$treatment)
#> [1] "placebo" "estPro"

Note that the reference category in newdata is still placebo. Therefore we must set increment = -1 in order to get the exposed dataset:

plot(fit_mason, 
     type = "hr", 
     newdata = newdata,
     var = "treatment",
     increment = -1,
     xvar = "time",
     ci = TRUE,
     rug = TRUE)

If the \(X\) variable has more than two levels, than, increment works the same way, e.g. increment = 2 will provide an exposed group two levels above the value in newdata.

Save results

In order to save the data used to make the plot, you simply have to assign the call to plot to a variable. This is particularly useful if you want to really customize the plot aesthetics:

result <- plot(fit_mason, 
               type = "hr", 
               newdata = newdata,
               var = "treatment",
               increment = -1,
               xvar = "time",
               ci = TRUE,
               rug = TRUE)

head(result)
#>    treatment      time log_hazard_ratio standarderror hazard_ratio lowerbound
#> 1%    estPro 0.9166667       -0.4832895     0.1760663    0.6167512  0.4367592
#> 2%    estPro 1.7500000       -0.3793964     0.1399023    0.6842743  0.5201698
#> 3%    estPro 2.5000000       -0.2858926     0.1184127    0.7513433  0.5957243
#> 4%    estPro 3.1666667       -0.2027782     0.1133642    0.8164593  0.6537908
#> 5%    estPro 3.4166667       -0.1716103     0.1154383    0.8423074  0.6717526
#> 6%    estPro 3.9166667       -0.1092744     0.1255777    0.8964844  0.7008916
#>    upperbound
#> 1%  0.8709194
#> 2%  0.9001509
#> 3%  0.9476140
#> 4%  1.0196011
#> 5%  1.0561653
#> 6%  1.1466599

Plot Hazards and Hazard Ratios

Sahir Rai Bhatnagar

2020-07-03

Introduction