Overview

Fit

  • binomial-regression IPCW, binreg
  • additive Lin-Ying model, aalenMets
  • cox model phreg
  • standard logistic regression via binreg

in the context of mediation analysis using mediation weights as in the medFlex package. We thus fit natural effects models, that for example on the binary scale might state that \[\begin{align*} \mbox{logit}(P(Y(x,M(x^*))=1| Z) = \beta_0+ \beta_1 x + \beta_2 x^* + \beta_3^T Z, \end{align*}\] in this case the the Natural Direct Effect (NDE) for fixed covariates \(Z\) is \[\begin{align*} \mbox{OR}_{1,0|Z}^{\mbox{NDE}} = \frac{\mbox{odds}(Y(1,M(x))|Z)}{\mbox{odds}(Y(0,M(x))|Z)} = \exp(\beta_1), \end{align*}\] and the Natural Inderect Effect (NIE) for fixed covariates \(Z\) is \[\begin{align*} \mbox{OR}_{1,0|Z}^{\mbox{NIE}} = \frac{\mbox{odds}(Y(x,M(1))|Z)}{\mbox{odds}(Y(x,M(0))|Z)} = \exp(\beta_2). \end{align*}\] See the medFlex package for additional discussion of the parametrization.

The mediator can be

  • binomial using glm-binomial.
  • multnomial via the mlogit function of mets

Both mediator and exposure must be coded as factors.

In the below example these are

  • mediator: gp.f
  • exposure : dnr.f

and the outcome model is concerned with the risk/hazard of cause=2.

The key is that the standard errors are computed using the i.i.d influence functions and a Taylor expansion to deal with the uncertainty from the mediation weights.

Simulated Data

First we simulate some data that mimics that of Kumar et al 2012. This is data from multiple myeloma patients treated with allogeneic stem cell transplantation from the Center for International Blood and Marrow Transplant Research (CIBMTR) Kumar et al (2012), “Trends in allogeneic stem cell transplantation for multiple myeloma: a CIBMTR analysis”. The data used in this paper consist of patients transplanted from 1995 to 2005, and we compared the outcomes between transplant periods: 2001-2005 (N=488) versus 1995-2000 (N=375). The two competing events were relapse (cause 2) and treatment-related mortality (TRM, cause 1)) defined as death without relapse. considered the following risk covariates: transplant time period (gp (main interest of the study): 1 for transplanted in 2001-2005 versus 0 for transplanted in 1995-2000), donor type (dnr: 1 for Unrelated or other related donor (N=280) versus 0 for HLA-identical sibling (N=584)), prior autologous transplant (preauto: 1 for Auto+Allo transplant (N=399) versus 0 for allogeneic transplant alone (N=465)) and time to transplant (ttt24: 1 for more than 24 months (N=289) versus 0 for less than or equal to 24 months (N=575))).

The interest is then on the effect of the period (gp) and the possible mediation via the amount of unrealted or related donors (dnr). A somewhat artificial example ! All adjusted for other important counfounders.

 library(mets)
 runb <- 0
 options(warn=-1)
 set.seed(1000) # to control output in simulatins for p-values below.

n <- 200; k.boot <- 10; 

dat <- kumarsimRCT(n,rho1=0.5,rho2=0.5,rct=2,censpar=c(0,0,0,0),
          beta = c(-0.67, 0.59, 0.55, 0.25, 0.98, 0.18, 0.45, 0.31),
    treatmodel = c(-0.18, 0.56, 0.56, 0.54),restrict=1)
dfactor(dat) <- dnr.f~dnr
dfactor(dat) <- gp.f~gp
drename(dat) <- ttt24~"ttt24*"
dat$id <- 1:n
dat$ftime <- 1

Mediation Weights

Then compute the mediation weights based on a mediation model

weightmodel <- fit <- glm(gp.f~dnr.f+preauto+ttt24,data=dat,family=binomial)
wdata <- medweight(fit,data=dat)

Binomial Regression

A simple multvariate regression of the probaibility of relapse at 50 months with both exposure and mediator (given the other covariates)

aaMss2 <- binreg(Event(time,status)~gp+dnr+preauto+ttt24+cluster(id),data=dat,time=50,cause=2)
summary(aaMss2)
#> 
#>    n events
#>  200     97
#> 
#>  200 clusters
#> coeffients:
#>             Estimate  Std.Err     2.5%    97.5% P-value
#> (Intercept) -1.09545  0.33261 -1.74736 -0.44355  0.0010
#> gp           1.26427  0.36725  0.54447  1.98407  0.0006
#> dnr          0.45202  0.39524 -0.32263  1.22667  0.2528
#> preauto      0.35124  0.38217 -0.39780  1.10028  0.3581
#> ttt24        0.55819  0.41228 -0.24987  1.36624  0.1758
#> 
#> exp(coeffients):
#>             Estimate    2.5%  97.5%
#> (Intercept)  0.33439 0.17423 0.6418
#> gp           3.54050 1.72370 7.2722
#> dnr          1.57148 0.72424 3.4099
#> preauto      1.42083 0.67180 3.0050
#> ttt24        1.74750 0.77890 3.9206

Binomial regression IPCW Mediation Analysis

We first look at the probability of relapse at 50 months

### binomial regression ###########################################################
aaMss <- binreg(Event(time,status)~dnr.f0+dnr.f1+preauto+ttt24+cluster(id),data=wdata,
        time=50,weights=wdata$weights,cause=2)
summary(aaMss)
#> 
#>    n events
#>  400    194
#> 
#>  200 clusters
#> coeffients:
#>              Estimate   Std.Err      2.5%     97.5% P-value
#> (Intercept) -0.520113  0.259635 -1.028987 -0.011238  0.0452
#> dnr.f01      0.339934  0.376813 -0.398605  1.078473  0.3670
#> dnr.f11      0.274655  0.071476  0.134564  0.414747  0.0001
#> preauto      0.552689  0.365370 -0.163423  1.268800  0.1304
#> ttt24        0.300601  0.380049 -0.444282  1.045483  0.4290
#> 
#> exp(coeffients):
#>             Estimate    2.5%  97.5%
#> (Intercept)  0.59445 0.35737 0.9888
#> dnr.f01      1.40486 0.67126 2.9402
#> dnr.f11      1.31608 1.14404 1.5140
#> preauto      1.73792 0.84923 3.5566
#> ttt24        1.35067 0.64128 2.8448

ll <- mediatorSurv(aaMss,fit,data=dat,wdata=wdata)
summary(ll)
#> 
#>    n events
#>  400    194
#> 
#>  200 clusters
#> coeffients:
#>              Estimate   Std.Err      2.5%     97.5% P-value
#> (Intercept) -0.520113  0.259239 -1.028211 -0.012014  0.0448
#> dnr.f01      0.339934  0.344113 -0.334515  1.014383  0.3232
#> dnr.f11      0.274655  0.117283  0.044785  0.504525  0.0192
#> preauto      0.552689  0.361565 -0.155966  1.261343  0.1264
#> ttt24        0.300601  0.381561 -0.447245  1.048447  0.4308
#> 
#> exp(coeffients):
#>             Estimate    2.5%  97.5%
#> (Intercept)  0.59445 0.35765 0.9881
#> dnr.f01      1.40486 0.71569 2.7577
#> dnr.f11      1.31608 1.04580 1.6562
#> preauto      1.73792 0.85559 3.5302
#> ttt24        1.35067 0.63939 2.8532
if (runb>0) { bll <- BootmediatorSurv(aaMss,fit,data=dat,k.boot=k.boot); summary(bll)}

So the NDE is \(1.40 (0.72,2.76)\) and the NIE is \(1.32 (1.05,1.66)\).

Mediation Analysis

We here also illustrate how to use the other models mentioned above.

### lin-ying model ################################################################
aaMss <- aalenMets(Surv(time/100,status==2)~dnr.f0+dnr.f1+preauto+ttt24+cluster(id),data=wdata,
           weights=wdata$weights)
ll <- mediatorSurv(aaMss,fit,data=dat,wdata=wdata)
summary(ll)
#> 
#>    n events
#>  400    196
#> coeffients:
#>          Estimate   Std.Err      2.5%     97.5% P-value
#> dnr.f01  1.169577  0.739320 -0.279463  2.618617  0.1137
#> dnr.f11  0.207542  0.131751 -0.050685  0.465769  0.1152
#> preauto  0.617555  0.504304 -0.370862  1.605973  0.2207
#> ttt24    0.457719  0.517829 -0.557207  1.472645  0.3767
#> 
#> exp(coeffients):
#>         Estimate    2.5%   97.5%
#> dnr.f01  3.22063 0.75619 13.7167
#> dnr.f11  1.23065 0.95058  1.5932
#> preauto  1.85439 0.69014  4.9827
#> ttt24    1.58046 0.57281  4.3608
if (runb>0) { bll <- BootmediatorSurv(aaMss,fit,data=dat,k.boot=k.boot); summary(bll)}

### cox model ###############################################################################
aaMss <- phreg(Surv(time,status==2)~dnr.f0+dnr.f1+preauto+ttt24+cluster(id),data=wdata,
           weights=wdata$weights)
summary(aaMss)
#> 
#>    n events
#>  400    196
#> coeffients:
#>         Estimate     S.E.  dU^-1/2 P-value
#> dnr.f01 0.414502 0.213721 0.157231  0.0524
#> dnr.f11 0.100682 0.039337 0.144971  0.0105
#> preauto 0.284446 0.232174 0.162375  0.2205
#> ttt24   0.185567 0.226049 0.160886  0.4117
#> 
#> exp(coeffients):
#>         Estimate    2.5%  97.5%
#> dnr.f01  1.51362 0.99563 2.3011
#> dnr.f11  1.10592 1.02386 1.1946
#> preauto  1.32903 0.84315 2.0949
#> ttt24    1.20390 0.77300 1.8750
ll <- mediatorSurv(aaMss,fit,data=dat,wdata=wdata)
summary(ll)
#> 
#>    n events
#>  400    196
#> coeffients:
#>            Estimate     Std.Err        2.5%       97.5% P-value
#> dnr.f01  0.41450188  0.20869260  0.00547189  0.82353187  0.0470
#> dnr.f11  0.10068179  0.05123705  0.00025902  0.20110457  0.0494
#> preauto  0.28444642  0.23038059 -0.16709124  0.73598408  0.2169
#> ttt24    0.18556746  0.22550192 -0.25640818  0.62754311  0.4106
#> 
#> exp(coeffients):
#>         Estimate    2.5%  97.5%
#> dnr.f01  1.51362 1.00549 2.2785
#> dnr.f11  1.10592 1.00026 1.2228
#> preauto  1.32903 0.84612 2.0875
#> ttt24    1.20390 0.77383 1.8730
if (runb>0) { bll <- BootmediatorSurv(aaMss,fit,data=dat,k.boot=k.boot); summary(bll)}

### Fine-Gray #############################################################3
aaMss <- cifreg(Event(time,status)~dnr.f0+dnr.f1+preauto+ttt24+cluster(id),data=wdata,
        weights=wdata$weights,propodds=NULL,cause=2)
summary(aaMss)
#> 
#>    n events
#>  400    196
#> 
#>  200 clusters
#> coeffients:
#>         Estimate     S.E.  dU^-1/2 P-value
#> dnr.f01 0.189343 0.219850 0.158549  0.3891
#> dnr.f11 0.187373 0.040836 0.145027  0.0000
#> preauto 0.414500 0.227838 0.160984  0.0689
#> ttt24   0.173048 0.228921 0.163080  0.4497
#> 
#> exp(coeffients):
#>         Estimate    2.5%  97.5%
#> dnr.f01  1.20846 0.78541 1.8594
#> dnr.f11  1.20608 1.11331 1.3066
#> preauto  1.51361 0.96845 2.3657
#> ttt24    1.18892 0.75910 1.8621
ll <- mediatorSurv(aaMss,fit,data=dat,wdata=wdata)
summary(ll)
#> 
#>    n events
#>  400    196
#> 
#>  200 clusters
#> coeffients:
#>          Estimate   Std.Err      2.5%     97.5% P-value
#> dnr.f01  0.189343  0.200074 -0.202795  0.581482  0.3440
#> dnr.f11  0.187373  0.075422  0.039548  0.335198  0.0130
#> preauto  0.414500  0.224302 -0.025124  0.854123  0.0646
#> ttt24    0.173048  0.229937 -0.277620  0.623717  0.4517
#> 
#> exp(coeffients):
#>         Estimate    2.5%  97.5%
#> dnr.f01  1.20846 0.81645 1.7887
#> dnr.f11  1.20608 1.04034 1.3982
#> preauto  1.51361 0.97519 2.3493
#> ttt24    1.18892 0.75758 1.8659
if (runb>0) { bll <- BootmediatorSurv(aaMss,fit,data=dat,k.boot=k.boot); summary(bll)}

### logit model  #############################################################3
aaMss <- cifreg(Event(time,status)~dnr.f0+dnr.f1+preauto+ttt24+cluster(id),data=wdata,
        weights=wdata$weights,cause=2)
summary(aaMss)
#> 
#>    n events
#>  400    196
#> 
#>  200 clusters
#> coeffients:
#>         Estimate     S.E.  dU^-1/2 P-value
#> dnr.f01 0.357164 0.339839 0.158937  0.2933
#> dnr.f11 0.272389 0.064148 0.145076  0.0000
#> preauto 0.657009 0.326087 0.160361  0.0439
#> ttt24   0.191334 0.353607 0.167443  0.5884
#> 
#> exp(coeffients):
#>         Estimate    2.5%  97.5%
#> dnr.f01  1.42927 0.73425 2.7822
#> dnr.f11  1.31310 1.15796 1.4890
#> preauto  1.92901 1.01805 3.6551
#> ttt24    1.21086 0.60549 2.4215
ll <- mediatorSurv(aaMss,fit,data=dat,wdata=wdata)
summary(ll)
#> 
#>    n events
#>  400    196
#> 
#>  200 clusters
#> coeffients:
#>          Estimate   Std.Err      2.5%     97.5% P-value
#> dnr.f01  0.357164  0.317638 -0.265395  0.979723  0.2608
#> dnr.f11  0.272389  0.111281  0.054283  0.490495  0.0144
#> preauto  0.657009  0.322616  0.024693  1.289325  0.0417
#> ttt24    0.191334  0.356870 -0.508119  0.890787  0.5919
#> 
#> exp(coeffients):
#>         Estimate    2.5%  97.5%
#> dnr.f01  1.42927 0.76690 2.6637
#> dnr.f11  1.31310 1.05578 1.6331
#> preauto  1.92901 1.02500 3.6303
#> ttt24    1.21086 0.60163 2.4370
if (runb>0) { bll <- BootmediatorSurv(aaMss,fit,data=dat,k.boot=k.boot); summary(bll)}

### binomial outcome  ############################
aaMss <- binreg(Event(ftime,status)~dnr.f0+dnr.f1+preauto+ttt24+cluster(id),data=wdata,
        time=50,weights=wdata$weights,cens.weights=1,cause=2)
summary(aaMss)
#> 
#>    n events
#>  400    196
#> 
#>  200 clusters
#> coeffients:
#>              Estimate   Std.Err      2.5%     97.5% P-value
#> (Intercept) -0.674433  0.235285 -1.135583 -0.213284  0.0042
#> dnr.f01      0.221834  0.318264 -0.401952  0.845620  0.4858
#> dnr.f11      0.262722  0.060281  0.144572  0.380871  0.0000
#> preauto      0.578077  0.319091 -0.047331  1.203484  0.0700
#> ttt24        0.214442  0.328183 -0.428784  0.857669  0.5135
#> 
#> exp(coeffients):
#>             Estimate    2.5%  97.5%
#> (Intercept)  0.50944 0.32123 0.8079
#> dnr.f01      1.24836 0.66901 2.3294
#> dnr.f11      1.30046 1.15555 1.4636
#> preauto      1.78261 0.95377 3.3317
#> ttt24        1.23917 0.65130 2.3577
ll <- mediatorSurv(aaMss,fit,data=dat,wdata=wdata)
summary(ll)
#> 
#>    n events
#>  400    196
#> 
#>  200 clusters
#> coeffients:
#>              Estimate   Std.Err      2.5%     97.5% P-value
#> (Intercept) -0.674433  0.235022 -1.135069 -0.213798  0.0041
#> dnr.f01      0.221834  0.286717 -0.340122  0.783789  0.4391
#> dnr.f11      0.262722  0.107508  0.052011  0.473432  0.0145
#> preauto      0.578077  0.315260 -0.039822  1.195975  0.0667
#> ttt24        0.214442  0.329107 -0.430596  0.859480  0.5147
#> 
#> exp(coeffients):
#>             Estimate    2.5%  97.5%
#> (Intercept)  0.50944 0.32140 0.8075
#> dnr.f01      1.24836 0.71168 2.1898
#> dnr.f11      1.30046 1.05339 1.6055
#> preauto      1.78261 0.96096 3.3068
#> ttt24        1.23917 0.65012 2.3619
if (runb>0) { bll <- BootmediatorSurv(aaMss,fit,data=dat,k.boot=k.boot); summary(bll)}

Multinomial regression

Also works with mediator with more than two levels

  • meditor: wmi in 4 categories
  • exposure: age in 4 categories
data(tTRACE)
dcut(tTRACE) <- ~. 

weightmodel <- fit <- mlogit(wmicat.4 ~agecat.4+vf+chf,data=tTRACE,family=binomial)
wdata <- medweight(fit,data=tTRACE)

aaMss <- binreg(Event(time,status)~agecat.40+ agecat.41+ vf+chf+cluster(id),data=wdata,
        time=7,weights=wdata$weights,cause=9)
summary(aaMss)
MultMed <- mediatorSurv(aaMss,fit,data=tTRACE,wdata=wdata)
summary(MultMed)
#> 
#>     n events
#>  4000   2016
#> 
#>  1000 clusters
#> coeffients:
#>                       Estimate   Std.Err      2.5%     97.5% P-value
#> (Intercept)          -1.837886  0.174671 -2.180236 -1.495537  0.0000
#> agecat.40(60.1,68.6]  0.911956  0.223683  0.473545  1.350366  0.0000
#> agecat.40(68.6,75.6]  1.367813  0.222395  0.931926  1.803699  0.0000
#> agecat.40(75.6,96.3]  2.284648  0.250033  1.794592  2.774704  0.0000
#> agecat.41(60.1,68.6]  0.121138  0.053348  0.016578  0.225698  0.0232
#> agecat.41(68.6,75.6]  0.119408  0.053222  0.015095  0.223722  0.0249
#> agecat.41(75.6,96.3]  0.095385  0.053904 -0.010265  0.201035  0.0768
#> vf                    0.704175  0.295938  0.124147  1.284202  0.0173
#> chf                   1.162855  0.154843  0.859368  1.466342  0.0000
#> 
#> exp(coeffients):
#>                      Estimate    2.5%   97.5%
#> (Intercept)           0.15915 0.11301  0.2241
#> agecat.40(60.1,68.6]  2.48919 1.60568  3.8588
#> agecat.40(68.6,75.6]  3.92675 2.53940  6.0721
#> agecat.40(75.6,96.3]  9.82223 6.01702 16.0339
#> agecat.41(60.1,68.6]  1.12878 1.01672  1.2532
#> agecat.41(68.6,75.6]  1.12683 1.01521  1.2507
#> agecat.41(75.6,96.3]  1.10008 0.98979  1.2227
#> vf                    2.02218 1.13218  3.6118
#> chf                   3.19905 2.36167  4.3334

SessionInfo

sessionInfo()
#> R version 4.3.2 (2023-10-31)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Ubuntu 22.04.3 LTS
#> 
#> Matrix products: default
#> BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
#> LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.20.so;  LAPACK version 3.10.0
#> 
#> locale:
#>  [1] LC_CTYPE=C.UTF-8       LC_NUMERIC=C           LC_TIME=C.UTF-8       
#>  [4] LC_COLLATE=C.UTF-8     LC_MONETARY=C.UTF-8    LC_MESSAGES=C.UTF-8   
#>  [7] LC_PAPER=C.UTF-8       LC_NAME=C              LC_ADDRESS=C          
#> [10] LC_TELEPHONE=C         LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C   
#> 
#> time zone: UTC
#> tzcode source: system (glibc)
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] mets_1.3.4     timereg_2.0.5  survival_3.5-7
#> 
#> loaded via a namespace (and not attached):
#>  [1] Matrix_1.6-1.1      future.apply_1.11.1 jsonlite_1.8.8     
#>  [4] compiler_4.3.2      Rcpp_1.0.12         stringr_1.5.1      
#>  [7] parallel_4.3.2      jquerylib_0.1.4     globals_0.16.2     
#> [10] splines_4.3.2       systemfonts_1.0.5   textshaping_0.3.7  
#> [13] yaml_2.3.8          fastmap_1.1.1       lattice_0.21-9     
#> [16] R6_2.5.1            knitr_1.45          future_1.33.1      
#> [19] desc_1.4.3          bslib_0.6.1         rlang_1.1.3        
#> [22] cachem_1.0.8        stringi_1.8.3       xfun_0.42          
#> [25] fs_1.6.3            sass_0.4.8          memoise_2.0.1      
#> [28] cli_3.6.2           pkgdown_2.0.7       magrittr_2.0.3     
#> [31] digest_0.6.34       grid_4.3.2          mvtnorm_1.2-4      
#> [34] lifecycle_1.0.4     lava_1.7.3          vctrs_0.6.5        
#> [37] evaluate_0.23       glue_1.7.0          listenv_0.9.1      
#> [40] numDeriv_2016.8-1.1 codetools_0.2-19    ragg_1.2.7         
#> [43] parallelly_1.37.0   rmarkdown_2.25      purrr_1.0.2        
#> [46] tools_4.3.2         htmltools_0.5.7