Chapter 7 Analyses - Outcome Quantitatif

7.1 Classiquement

On inclut seulement les vivants à 44 ans (N = versus 939).

Les hommes ont une TAS en moyenne plus élevé à 44 ans. 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 = 386 )

7.2 CMAverse

exp1 <- cmest(
  data = base2,                    # 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 = "t8_SBP",                 
  exposure = "t0_baby_sex", 
  mediator = c("t4_tabac_2cl"), 
  basec = c("t0_mother_scol_crt"),# confusion baseline
  #postc =                        # si confusion intermédiaire
  
  yreg = "linear",              # outcome regression model

  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
  ) ;    set.seed(28062022)

L’effet total du fait d’être né homme sur la TAS moyenne à 44 ans est : +12.53mmHg (95CI = [6.97 to 15.04]). La part médiée est de : 0.04% (95CI = [-1.86 to 1.79]). C’est à dire qu’on n’explique pas les différences de TAS par le tabagisme au début de l’age adulte.

7.3 “A la main”

## imputation
library(mice)

  B <- 100
  for (i in 1:B){ 
  # sample the indices 1 to n with replacement
  bootIndices <- sample(1:nrow(base2), replace=T) ;    set.seed(28062022+i*6)
  a_imputer <- base2[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
  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 <- lm(formula = t8_SBP ~ t0_baby_sex  + 
                   t0_mother_scol_crt , data=bootData)
    Q.model.M <- lm(formula = t8_SBP ~ t0_baby_sex  + 
                   t0_mother_scol_crt+ t4_tabac_2cl, data=bootData)
    
    # TE Sex on AL  #
    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 Sex on AL  #
    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 = "")))

La TAS à 44 est plus élevé chez les hommes de +11.65mmHg (95CI = [4.02 to 18.23]). La part éliminée est de : -0.17% (95CI = [-3.5 to 2.99]).

7.4 Analyse de sensibilité pour la confusion résiduelle

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
## cde  1.925938 1.5547575 2.385734     3.261341       2.483473             NA
## pnde 1.925938 1.5547575 2.385734     3.261341       2.483473             NA
## tnde 1.925938 1.5547575 2.385734     3.261341       2.483473             NA
## pnie 1.000624 0.9930398 1.008266     1.025610       1.000000             NA
## tnie 1.000624 0.9930398 1.008266     1.025610       1.000000             NA
## te   1.927140 1.5562219 2.386464     3.263825       2.486601             NA

Plus difficile à interpréter avec un outcome quantitatif.