Introduction to Excess Hazard Modelling Considering Inappropriate Mortality Rates

library(xhaz)
#> Le chargement a nécessité le package : statmod
#> Le chargement a nécessité le package : survival

Introduction

xhaz is an R package to fit excess hazard regression models. The baseline excess hazard could be a piecewise constant function or a B-splines. When B-splines is chosen for the baseline excess hazard, the user can specify some covariates which have a time-dependent effect (using “bsplines”) on the baseline excess hazard.

The user can specify whether the framework is consistent with classical excess hazard modeling by assuming that the expected mortality from the life tables is appropriate, using the argument (`pophaz = classic) . Alternatively, the user may consider two other frameworks:

There is a non-comparability source of bias regarding the expected mortality of the study population as in Goungounga et al. (2019). This is specified with (pophaz=rescaled). The expected mortality in the life tables is inaccurate and needs to be corrected with an additional variable. This correction can be made by introducing a scaling factor that acts proportionally (Touraine et al. (2020)) or non-proportionally ((Mba et al. (2020)) for each level of the additional variable on the expected mortality rates. This is specified with (pophaz=corrected).

(Here’s the abstract from Touraine et al. paper: Relative survival methods used to estimate the excess mortality of cancer patients rely on the background (or expected) mortality derived from general population life tables. These methods are based on splitting the observed mortality into the excess mortality and the background mortality…

A related software package can be found at a gitlab webpage or at https://CRAN.R-project.org/package=xhaz.

Installation

The most recent version of xhaz can be installed directly from the cran repository using

install.packages("xhaz")

xhaz depends on the stats, survival, optimParallel, numDeriv, statmod, gtools and splines packages which can be installed directly from CRAN.

It also utilizes survexp.fr, the R package containing the French life tables. For example, to install survexp.fr follow the instructions available at the RStudio page on R and survexp.fr.

Then, when these other packages are installed, please load the xhaz R package.

library(xhaz)

Fitting an classical excess hazard regression model with a piecewise constant baseline hazard

We illustrate the Esteve model using a simulated dataset from the original Touraine et al. (2020) paper. This dataset is comprised of 2,000 patients with an information regarding their race as this information can impact the patient background mortality. The US life tables can be used for the estimation of the model parameters.

data("simuData", package = "xhaz")

head(simuData)
#>        age       agec  sex  race       date     time status time_year
#> 1 50.52825 -1.3186092 male black 1990-10-21 72.00000      0  6.000000
#> 2 62.50834 -0.4380647 male black 1990-07-17 72.00000      0  6.000000
#> 3 64.49190 -0.2922719 male black 1990-10-18 20.15947      1  1.679956
#> 4 48.23570 -1.4871131 male white 1990-12-06 13.78553      1  1.148794
#> 5 31.71262 -2.7015697 male black 1990-01-20 72.00000      0  6.000000
#> 6 31.11493 -2.7455005 male black 1990-01-17 18.73011      1  1.560842
dim(simuData)
#> [1] 2000    8

interval <- c(0, 0.718, 1.351, 2.143, 3.601, 6)
fit.estv1 <- xhaz(formula = Surv(time_year, status) ~ agec + race,
                  data = simuData,
                  ratetable = survexp.us,
                  interval = interval,
                  rmap = list(age = 'age', sex = 'sex', year = 'date'),
                  baseline = "constant",
                  pophaz = "classic")
                  
fit.estv1
#> Call:
#> xhaz(formula = Surv(time_year, status) ~ agec + race, data = simuData, 
#>     ratetable = survexp.us, rmap = list(age = "age", sex = "sex", 
#>         year = "date"), baseline = "constant", pophaz = "classic", 
#>     interval = interval)
#> 
#> 
#>                coef se(coef) lower 0.95 upper 0.95     z Pr(>|z|)    
#> agec         0.3340   0.0384     0.2588     0.4092  8.70  < 2e-16 ***
#> racewhite   -0.5737   0.1422    -0.8524    -0.2949 -4.03  5.5e-05 ***
#> [0-0.72[     0.1577   0.0124     0.1335     0.1820 12.74  < 2e-16 ***
#> [0.72-1.35[  0.2317   0.0171     0.1981     0.2652 13.52  < 2e-16 ***
#> [1.35-2.14[  0.2226   0.0168     0.1897     0.2556 13.24  < 2e-16 ***
#> [2.14-3.6[   0.1489   0.0122     0.1250     0.1728 12.21  < 2e-16 ***
#> [3.6-6[      0.1216   0.0107     0.1007     0.1426 11.37  < 2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> 
#> Excess hazard hazard ratio(s)
#> (proportional effect variable(s) for exess hazard ratio(s))
#>           exp(coef) lower 0.95 upper 0.95
#> agec         1.3965     1.2953     1.5056
#> racewhite    0.5635     0.4264     0.7446
#> 
#> number of observations: 2000;  number of events: 1375
#> Likelihood ratio test: 103  on 7 degree(s) of freedom, p=0

Fitting an excess hazard regression model with a piecewise constant baseline hazard with background mortality corrected with proportional effect for race variable

The new parameter to be added to xhaz() function is “add.rmap”: it allows to specify the additional variable for the life tables needed for the estimation of the excess hazard parameters. This model concerns that proposed by Touraine et al (2020).

fit.corrected1 <- xhaz(formula = Surv(time_year, status) ~ agec + race,
                       data = simuData,
                       ratetable = survexp.us,
                       interval = interval,
                       rmap = list(age = 'age', sex = 'sex', year = 'date'),
                       baseline = "constant", pophaz = "corrected",
                       add.rmap = "race")
                       
fit.corrected1
#> Call:
#> xhaz(formula = Surv(time_year, status) ~ agec + race, data = simuData, 
#>     ratetable = survexp.us, rmap = list(age = "age", sex = "sex", 
#>         year = "date"), baseline = "constant", pophaz = "corrected", 
#>     add.rmap = "race", interval = interval)
#> 
#> 
#>                     coef se(coef) lower 0.95 upper 0.95     z Pr(>|z|)    
#> agec              0.2924   0.0796     0.1364     0.4484  3.67  0.00024 ***
#> racewhite        -0.2065   0.1940    -0.5868     0.1738 -1.06  0.29000    
#> [0-0.72[          0.1423   0.0204     0.1023     0.1824  6.97  3.1e-12 ***
#> [0.72-1.35[       0.2138   0.0247     0.1653     0.2623  8.64  < 2e-16 ***
#> [1.35-2.14[       0.2061   0.0263     0.1545     0.2578  7.83  5.0e-15 ***
#> [2.14-3.6[        0.1319   0.0239     0.0850     0.1788  5.51  3.6e-08 ***
#> [3.6-6[           0.1081   0.0237     0.0617     0.1546  4.57  5.0e-06 ***
#> log(alpha.black)  0.3214   0.3025    -0.2715     0.9144  1.06  0.29000    
#> log(alpha.white) -0.9047   1.0124    -2.8889     1.0795 -0.89  0.37000    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> 
#> Excess hazard hazard ratio(s)
#> (proportional effect variable(s) for exess hazard ratio(s))
#>           exp(coef) lower 0.95 upper 0.95
#> agec         1.3396     1.1461      1.566
#> racewhite    0.8134     0.5561      1.190
#> 
#> and corrected scale parameters on population hazard 
#>             exp(coef) lower 0.95 upper 0.95
#> alpha.black    1.3791    0.76221      2.495
#> alpha.white    0.4047    0.05564      2.943
#> 
#> number of observations: 2000;  number of events: 1375
#> Likelihood ratio test: 13.8  on 9 degree(s) of freedom, p=0.129

Fitting an excess hazard regression model with a piecewise constant baseline hazard with background mortality corrected with non proportional effect for race variable

The new parameter to be added to xhaz() function is “add.rmap.cut”: it furthermore allows to specify that the additional variable have a non proportional effect on the background mortality. This excess hazard regression model concerns that proposed by Mba et al (2020).

 # An additionnal cavariate (here race) missing in the life tables is
 # considered by the model with a breakpoint at 75 years

 fit.corrected2 <- xhaz(formula = Surv(time_year, status) ~ agec + race,
                        data = simuData,
                        ratetable = survexp.us,
                        interval = interval,
                        rmap = list(age = 'age', sex = 'sex', year = 'date'),
                        baseline = "constant", pophaz = "corrected",
                        add.rmap = "race",
                        add.rmap.cut = list(breakpoint = TRUE, cut = 75))



 fit.corrected2
#> Call:
#> xhaz(formula = Surv(time_year, status) ~ agec + race, data = simuData, 
#>     ratetable = survexp.us, rmap = list(age = "age", sex = "sex", 
#>         year = "date"), baseline = "constant", pophaz = "corrected", 
#>     add.rmap = "race", add.rmap.cut = list(breakpoint = TRUE, 
#>         cut = 75), interval = interval)
#> 
#> 
#>                               coef se(coef) lower 0.95 upper 0.95     z
#> agec                        0.2676   0.1017     0.0682     0.4670  2.63
#> racewhite                  -0.3271   0.2982    -0.9117     0.2574 -1.10
#> [0-0.72[                    0.1243   0.0248     0.0757     0.1728  5.02
#> [0.72-1.35[                 0.1765   0.0285     0.1207     0.2324  6.20
#> [1.35-2.14[                 0.1699   0.0301     0.1109     0.2289  5.65
#> [2.14-3.6[                  0.1027   0.0291     0.0457     0.1597  3.53
#> [3.6-6[                     0.0703   0.0265     0.0184     0.1222  2.66
#> log(alpha.black_(30.9,75])  1.2928   0.1937     0.9132     1.6724  6.67
#> log(alpha.black_(75,90.9])  0.6122   0.2327     0.1562     1.0682  2.63
#> log(alpha.white_(30.9,75])  1.0285   0.4221     0.2012     1.8558  2.44
#> log(alpha.white_(75,90.9]) -0.2209   0.4767    -1.1552     0.7135 -0.46
#>                            Pr(>|z|)    
#> agec                        0.00850 ** 
#> racewhite                   0.27000    
#> [0-0.72[                    5.2e-07 ***
#> [0.72-1.35[                 5.7e-10 ***
#> [1.35-2.14[                 1.6e-08 ***
#> [2.14-3.6[                  0.00041 ***
#> [3.6-6[                     0.00790 ** 
#> log(alpha.black_(30.9,75])  2.5e-11 ***
#> log(alpha.black_(75,90.9])  0.00850 ** 
#> log(alpha.white_(30.9,75])  0.01500 *  
#> log(alpha.white_(75,90.9])  0.64000    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> 
#> Excess hazard hazard ratio(s)
#> (proportional effect variable(s) for exess hazard ratio(s))
#>           exp(coef) lower 0.95 upper 0.95
#> agec          1.307     1.0706      1.595
#> racewhite     0.721     0.4018      1.294
#> 
#> and corrected scale parameters on population hazard 
#>  (non proportional correction using breakpoint approach)
#> 
#>                       exp(coef) lower 0.95 upper 0.95
#> alpha.black_(30.9,75]    3.6430      2.492      5.325
#> alpha.black_(75,90.9]    1.8445      1.169      2.910
#> alpha.white_(30.9,75]    2.7970      1.223      6.397
#> alpha.white_(75,90.9]    0.8018      0.315      2.041
#> 
#> 
#> number of observations: 2239;  number of events: 1491
#> Likelihood ratio test: 7.15  on 11 degree(s) of freedom, p=0.787

We can compare the output of these two models using AIC or BIC criteria.

AIC(fit.estv1)
#> [1] 6766.99
AIC(fit.corrected1)
#> [1] 6766.018

BIC(fit.estv1)
#> [1] 6806.196
BIC(fit.corrected1)
#> [1] 6816.426

A statistical comparison between two nested models can be performed with a likelihood ratio test calculated by function anova method implemented in xhaz.

As an example, say that we want to test whether we can drop all the complex terms in the Mba model compared to the Touraine model.

As in survival package, We compare the two models using anova(), i.e.,

anova(fit.corrected1, fit.corrected2)
#> Assumption: Model 1 nested within Model 2
#> 
#> Likelihood ratio test
#> Model 1: 
#> Surv(time_year, status) ~ agec + race
#> Model 2: 
#> Surv(time_year, status) ~ agec + race
#>      Model.df  loglik      df  Chisq Pr(>Chisq)    
#> [1,]      9.0 -3374.0      NA     NA         NA    
#> [2,]     11.0 -3528.6     2.0 154.54  < 2.2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Note that the user is responsible to supply appropriately nested excess hazard regression models such that the LRT to be valid. The result suggests that we could use the Mba model with non-proportional population hazards, correcting for the life tables with additional stratification on the variable “race”.

Plot of net survival and excess hazard for different models

One could be interested to the prediction of net survival and excess hazard of the individual with the same characteristics as individual 1 on the SimuData (age 50.5, race black)


#only add Surv variables (time_year and status) to have them in the new.data. 
#They are not used for the prediction

simuData[1,]
#>        age      agec  sex  race       date time status time_year
#> 1 50.52825 -1.318609 male black 1990-10-21   72      0         6


newdata1 <-
  expand.grid(
    race = factor("black",
                   levels = levels(simuData$race)),
    agec  = simuData[1, "agec"], #i.e age 50.5 years
    time_year = 0,
    status = 0
  )



predict_mod1 <- predict(object = fit.estv1,
                        new.data = newdata1,
                        times.pts = c(seq(0, 6, 0.1)),
                        baseline = FALSE)


predict_mod2 <- predict(object = fit.corrected1,
                        new.data = newdata1,
                        times.pts = c(seq(0, 6, 0.1)),
                        baseline = FALSE)



predict_mod3 <- predict(object = fit.corrected2,
                        new.data = newdata1,
                        times.pts = c(seq(0, 6, 0.1)),
                        baseline = FALSE)
old.par <- par(no.readonly = TRUE)
par(mfrow = c(2, 1))


plot(
  predict_mod1,
  what = "survival",
  xlab = "time since diagnosis (year)",
  ylab = "net survival",
  ylim = c(0, 1),
  main = "Estève Model"
)

par(new = TRUE)

plot(
  predict_mod2,
  what = "survival",
  xlab = "",
  ylab = "",
  ylim = c(0, 1),
  lty = 2,
  lwd = 2# main = "Touraine Model"
)

par(new = TRUE)
plot(
  predict_mod3,
  what = "survival",
  xlab = "",
  ylab = "",
  ylim = c(0, 1),
  lty = 3,
  lwd = 3#main = "Mba Model"
)
legend(
  "bottomleft",
  legend = c("Esteve Model",
             "Touraine Model",
             "Mba Model"),
  lty = c(1, 2 , 3),
  lwd = c(1, 2 , 3)
)


plot(
  predict_mod1,
  what = "hazard",
  xlab = "time since diagnosis (year)",
  ylab = "excess hazard",
  ylim = c(0, 0.30),
  lty = 1
)

par(new = TRUE)
plot(
  predict_mod2,
  what = "hazard",
  xlab = "",
  ylab = "",
  ylim = c(0, 0.30),
  lty = 2,
  lwd = 2
)
par(new = TRUE)
plot(
  predict_mod3,
  what = "hazard",
  xlab = "",
  ylab = "",
  ylim = c(0, 0.30),
  lty = 3,
  lwd = 3
)

legend(
  "topright",
  legend = c("Esteve Model",
             "Touraine Model",
             "Mba Model"),
  lty = c(1, 2 , 3),
  lwd = c(1, 2 , 3)
)

par(old.par)

One could be interested to the prediction of marginal net survival and marginal excess hazard of the individual with the same characteristics as observed in the simuData.


#only add Surv variables (time_year and status) to have them in the new.data. 
#They are not used for the prediction
#we could be interested to the prediction of net survival and excess hazard of the individual we the same characteristics that this one (age 50.5, race black)

predmar_mod1 <- predict(object = fit.estv1,
                        new.data = simuData,
                        times.pts = c(seq(0, 6, 0.1)),
                        baseline = FALSE)


predmar_mod2 <- predict(object = fit.corrected1,
                        new.data = simuData,
                        times.pts = c(seq(0, 6, 0.1)),
                        baseline = FALSE)



predmar_mod3 <- predict(object = fit.corrected2,
                        new.data = simuData,
                        times.pts = c(seq(0, 6, 0.1)),
                        baseline = FALSE)

par(mfrow = c(2, 1))


plot(
  predmar_mod1,
  what = "survival",
  xlab = "time since diagnosis (year)",
  ylab = "net survival",
  ylim = c(0, 1),
  main = "Estève Model"
)

par(new = TRUE)
plot(
  predmar_mod2,
  what = "survival",
  xlab = "",
  ylab = "",
  ylim = c(0, 1),
  lty = 2,
  lwd = 2# main = "Touraine Model"
)

par(new = TRUE)
plot(
  predmar_mod3,
  what = "survival",
  xlab = "",
  ylab = "",
  ylim = c(0, 1),
  lty = 3,
  lwd = 3#main = "Mba Model"
)
legend(
  "bottomleft",
  legend = c("Esteve Model",
             "Touraine Model",
             "Mba Model"),
  lty = c(1, 2 , 3),
  lwd = c(1, 2 , 3)
)


plot(
  predmar_mod1,
  what = "hazard",
  xlab = "time since diagnosis (year)",
  ylab = "excess hazard",
  ylim = c(0, 0.30),
  lty = 1
)

par(new = TRUE)
plot(
  predmar_mod2,
  what = "hazard",
  xlab = "",
  ylab = "",
  ylim = c(0, 0.30),
  lty = 2,
  lwd = 2
)
par(new = TRUE)
plot(
  predmar_mod3,
  what = "hazard",
  xlab = "",
  ylab = "",
  ylim = c(0, 0.30),
  lty = 3,
  lwd = 3
)

legend(
  "topright",
  legend = c("Esteve Model",
             "Touraine Model",
             "Mba Model"),
  lty = c(1, 2 , 3),
  lwd = c(1, 2 , 3)
)

par(old.par)

License

GPL 3.0, for academic use.

Acknowledgments

We are grateful to the members of the CENSUR Survival Group for their helpful comments.