Chapter 6 Analyses - Outcome Qualitatif

6.1 Classiquement

On peut commencer par explorer la médiation de façon classique par régression séquentielle :

dead_44		Non	Oui	OR (multivariable)	OR (multivariable full)
t0_mother_scol_crt	Non	150 (95.5)	7 (4.5)	-	-
	Oui	469 (96.5)	17 (3.5)	0.77 (0.33 to 2.03)	0.77 (0.32 to 2.02)
t0_baby_sex	Femme	311 (96.6)	11 (3.4)	-	-
	Homme	308 (96.0)	13 (4.0)	1.20 (0.53 to 2.78)	1.20 (0.53 to 2.78)
t4_tabac_2cl	Non	400 (96.4)	15 (3.6)	-	-
	Oui	219 (96.1)	9 (3.9)	-	1.11 (0.46 to 2.55)

Ici, on peut observer que les hommes ont un risque de décès avant 44 ans plus important, même si ce n’est pas significatif. Cette différence ne semble pas changer quand on ajuste sur le tabagisme. Attention cette analyse a été réalisée sur cas complets (N = 643)

6.2 CMAverse

Le package CMAverse permet de réaliser une analyse de médiation de façon simple.

exp1 <- cmest(
  data = base,                    # base
  model = "gformula",             # approach, defaut is rb (regression-based)
                                  # if postc is not empty only gformula or msm
  estimation = "imputation",      # method of estimation. "imputation" is conterfactual estimation
  inference = "bootstrap",        # method for se and CI
  nboot = 100,                    # defaut is 200
  EMint = FALSE,                  # interaction exposure mediator
  
  multimp = TRUE,                 # imputation multiple des DM 
  m = 10,

  outcome = "dead_44",                 
  exposure = "t0_baby_sex", 
  mediator = c("t4_tabac_2cl"), 
  basec = c("t0_mother_scol_crt"),# confusion baseline
  #postc =                        # si confusion intermédiaire
  
  yreg = "logistic",              # outcome regression model
  yval = "Oui",                   # value = risque for outcome if categorical
  
  a = "Homme",                    # "active" value of exposure
  astar = "Femme",                # "control" value of exposure
  
  mreg = list("logistic"),          # regression model for each mediator
  mval = list("Non")                 # ref for M
  )

Résultats :

type	effect	ci.low	ci.high
Rcde	1.35	0.81	2.40
Rpnde	1.34	0.81	2.39
Rtnde	1.34	0.81	2.39
Rpnie	1.00	0.96	1.04
Rtnie	1.00	0.96	1.04
Rte	1.34	0.81	2.41
pm	-0.00	-1.67	0.86

L’effet total du fait d’être une homme sur le risque de décès avant 44 ans est (ratio scale): x1.34 (95CI = [0.81 to 2.41]). La part médiée est de : -0.31% (95CI = [-166.51 to 85.74]). C’est à dire qu’on n’explique très peu (et de façon non significative) les différences de mortalité précoce entre les hommes et les femmes par le tabagisme au début de l’age adulte.

6.3 “A la main”

Si on avait réalisé cette analyse sans package, on aurait pu faire :

## imputation
library(mice)
  B <- 100
  for (i in 1:B){ 
  # sample the indices 1 to n with replacement
  bootIndices <- sample(1:nrow(base), replace=T) ;    set.seed(28062022+i*6)
  a_imputer <- base[bootIndices,]
  a_imputer <- mice (a_imputer, m=1, maxit = 5) ;    set.seed(28062022+i*6)
  a_imputer <- complete(a_imputer)
  a_imputer <- a_imputer %>% 
    mutate(num_base = i) 
  name <- paste("base_", i, sep = "")
  assign(name,a_imputer) 
  rm(a_imputer)}
dfs <- lapply(ls(pattern="^base_"), function(x) get(x))
all_base <- data.table::rbindlist(dfs)


# calcul TE et PM, sur les 100 bases bootstrappées et imputées (pour calcul IC)

  simu.base <- data.frame(i.simu=c(1:B),est.TE=c(1:B), est.PM=c(1:B))
  
  for (i in 1:B){ 
    # sample the indices 1 to n with replacement
    bootData <- all_base[which(all_base$num_base == i)]
    Q.model <- glm(formula = dead_44 ~ t0_baby_sex  + 
                   t0_mother_scol_crt , data=bootData, family = "binomial" )
    Q.model.M <- glm(formula = dead_44 ~ t0_baby_sex  + 
                   t0_mother_scol_crt+ t4_tabac_2cl, data=bootData, 
                   family = "binomial")
    
    # TE   #
    data.S1 <-  data.S2 <- bootData
    data.S1$t0_baby_sex <- "Homme"
    data.S2$t0_baby_sex <- "Femme"
    
    dead.S1.pred <- predict(Q.model, newdata = data.S1, type = "response")
    dead.S2.pred <- predict(Q.model, newdata = data.S2, type = "response")
    simu.base$est.TE[simu.base$i.simu==i] = 
      round(mean(dead.S1.pred -  dead.S2.pred, na.rm = TRUE),4)
    
    # PM   #
    data.S1.M0 <-  data.S2.M0  <- bootData
    data.S1.M0 $t0_baby_sex <- "Homme"
    data.S2.M0 $t0_baby_sex <- "Femme"
    data.S1.M0 $t4_tabac_2cl <- "Non"
    data.S2.M0 $t4_tabac_2cl <- "Non"
    
    dead.S1Z0.pred <- predict(Q.model.M, newdata = data.S1.M0, type = "response")
    dead.S0Z0.pred <- predict(Q.model.M, newdata = data.S2.M0, type = "response")
    simu.base$est.PM[simu.base$i.simu==i] = 
      ((simu.base$est.TE[simu.base$i.simu==i] - 
          round(mean(dead.S1Z0.pred - 
                       dead.S0Z0.pred,na.rm = TRUE),4))/
         simu.base$est.TE[simu.base$i.simu==i])*100
  }
  
  effects <- round(colMeans(simu.base),2)
  confint <- apply(simu.base, 2, function(x) quantile(x,probs = c(0.025, 0.975)))
  
  result <- data.frame(
                type = c("TE", "PE (%)"),
                effect = c(effects[2] , effects[3] ),
                CI = c(paste("[",
                             round(confint[1,2],2),
                             " to ",
                             round(confint[2,2],2),
                             "]", sep = ""), 
                       paste("[",
                            round(confint[1,3],2),
                            " to ",
                            round(confint[2,3],2),
                            "]", sep = "")))

Résultats :

type	effect	CI
TE	0.02	[-0.01 to 0.04]
PE (%)	0.55	[-33.18 to 53.64]

Le risque de décéder avant 44 est plus élevé chez les hommes de (Difference scale) +0.02% (95CI = [-0.01 to 0.04]). La part éliminée par le tabagisme est de : 0.55% (95CI = [-33.18 to 53.64]).

On retrouve des résultats similaires à l’analyse avec le package CMAverse.

6.4 Analyse de sensibilité pour la confusion résiduelle

La E-value a été proposé par Vanderweele pour évaluer l’impact d’une potentielle confusion résiduelle. Elle correpond à la force minimale de l’association qu’un facteur de confusion non mesuré devrait avoir à la fois avec l’exposition et l’outcome pour faire disparaitre l’association entre X et Y, conditionnellement aux covariables mesurées.

Le package CMAverse permet de calculer cette E-value.

sens1 <- cmsens(object = exp1, 
                sens = "uc") # for unmeasured confunding
print(sens1)

## Sensitivity Analysis For Unmeasured Confounding 
## 
## Evalues on the risk or rate ratio scale: 
##           estRR   lowerRR  upperRR Evalue.estRR Evalue.lowerRR Evalue.upperRR
## Rcde  1.3451442 0.8119243 2.396430     2.026517              1             NA
## Rpnde 1.3443139 0.8124887 2.389894     2.024656              1             NA
## Rtnde 1.3443144 0.8125000 2.389843     2.024657              1             NA
## Rpnie 0.9993173 0.9594617 1.043021     1.026830             NA              1
## Rtnie 0.9993176 0.9595845 1.042949     1.026823             NA              1
## Rte   1.3433965 0.8079721 2.410564     2.022600              1             NA

E-value pour les effets total, directs et indirects =1 car les effets ne sont pas significatifs.