R/EXCELexport.R

In INESSSQC/polymedic: Calculs de la polypharmacie

#' Tableau statistiques dans EXCEL
#' 
#' Statistiques descriptives pour toutes les strates existantes (Âge, Sexe, Défavorisation sociale, etc.).
#'
#' @param sim Résultat de la fonction \code{polysimul()}.
#' @param cum Résultat de la fonction \code{polycumul()}.
#' @param cump Résultat de la fonction \code{polycumulpond()}.
#' @param con Résultat de la fonction \code{polyconti()}.
#' @param noint Résultat de la fonction \code{polynointer()}.
#'
#' @import data.table
#' @import plyr
#'
#' @export
EXCELexport <- function(sim, cum, cump, con, noint) {
  
  #### Stats et distribution des indicateurs ####
  
  #### * simul - Simultanée ####
  ## Statistiques
  dt <- copy(sim$pop_stats_group)
  all <- copy(sim$pop_stats)
  # Statistiques sur les colonnes :
  statscol <- c("Moyenne", "Min", "Médiane", "Max")
  # Indiquer la colonne faisant référence aux statistiques
  for (j in statscol) {
    all[[j]] <- cbind(data.table(`Mesure individuelle` = j),
                      all[[j]],
                      data.table(n = all$n))
    for (i in names(dt)) {
      dt[[i]][[j]] <- cbind(data.table(`Mesure individuelle` = rep(j, nrow(dt[[i]][[j]]))),
                            dt[[i]][[j]],
                            data.table(n = dt[[i]][["n"]]))
    }
  }
  # Coller les tableaux ensembles
  simultab <- as.data.table(rbind.fill(Reduce(function(x, y){rbind(x,y)}, dt$`CatAge & Sexe`[statscol]),
                                       Reduce(function(x, y){rbind(x,y)}, dt$CatAge[statscol]),
                                       Reduce(function(x, y){rbind(x,y)}, dt$Sexe[statscol]),
                                       Reduce(function(x, y){rbind(x,y)}, all[statscol])))
  simultab <- cbind(data.table(`Méthode` = rep("Simultanée", nrow(simultab))),
                    simultab)
  # Changer NA par "Tous"
  for(j in names(simultab)){
    set(simultab, which(is.na(simultab[[j]])), j, "Tous")
  }
  stats_tab <- copy(simultab); rm(simultab)
  ## Distribution
  dist <- copy(sim$dist_values)
  dist <- rbind.fill(lapply(names(dist), function(x) {
    dist[[x]] <- cbind(data.table(`Mesure individuelle` = rep(x, nrow(dist[[x]]))),
                       dist[[x]])
  }))
  dist_tab <- cbind(data.table(`Méthode` = rep("Simultanée", nrow(dist))),
                    dist)
  rm(dist)
  
  #### * cumul - Cumulée ####
  ## Statistiques
  dt <- copy(cum$stats_group)
  all <- copy(cum$stats)
  # Coller les tableaux ensembles
  cumtab <- rbind.fill(rbind.fill(dt), all)
  # Changer NA par "Tous"
  for(j in names(cumtab)){
    set(cumtab, which(is.na(cumtab[[j]])), j, "Tous")
  }
  # Méthode et Mesure individuelle
  cumtab <- cbind(data.table(`Méthode` = rep("Cumulée", nrow(cumtab)),
                             `Mesure individuelle` = rep("", nrow(cumtab))),
                  cumtab)
  stats_tab <- rbind(stats_tab, cumtab); rm(cumtab)
  ## Distribution
  dist_tab <- rbind(dist_tab, cbind(data.table(`Méthode` = rep("Cumulée", nrow(cum$dist_max)),
                                               `Mesure individuelle` = rep("", nrow(cum$dist_max))),
                                    cum$dist_max))
  
  #### * cumulpond - Cumulée pondérée ####
  ## Statistiques
  dt <- copy(cump$stats_group)
  all <- copy(cump$stats)
  # Coller les tableaux ensembles
  cumptab <- rbind.fill(rbind.fill(dt), all)
  # Changer NA par "Tous"
  for(j in names(cumptab)){
    set(cumptab, which(is.na(cumptab[[j]])), j, "Tous")
  }
  # Méthode et Mesure individuelle
  cumptab <- cbind(data.table(`Méthode` = rep("Cumulée pondérée", nrow(cumptab)),
                             `Mesure individuelle` = rep("", nrow(cumptab))),
                  cumptab)
  stats_tab <- rbind(stats_tab, cumptab); rm(cumptab)
  ## Distribution
  dist_tab <- rbind(dist_tab, cbind(data.table(`Méthode` = rep("Cumulée pondérée", nrow(cump$dist_max_arrondi)),
                                               `Mesure individuelle` = rep("", nrow(cump$dist_max_arrondi))),
                                    cump$dist_max_arrondi))
  
  #### * conti - Continue ####
  ## Statistiques
  dt <- copy(con$stats_group)
  all <- copy(con$stats)
  # Coller les tableaux ensembles
  contab <- rbind.fill(rbind.fill(dt), all)
  # Changer NA par "Tous"
  for(j in names(contab)){
    set(contab, which(is.na(contab[[j]])), j, "Tous")
  }
  # Méthode et Mesure individuelle
  contab <- cbind(data.table(`Méthode` = rep("Continue", nrow(contab)),
                             `Mesure individuelle` = rep("", nrow(contab))),
                  contab)
  stats_tab <- rbind(stats_tab, contab); rm(contab)
  ## Distribution
  dist_tab <- rbind(dist_tab, cbind(data.table(`Méthode` = rep("Continue", nrow(con$dist_max)),
                                               `Mesure individuelle` = rep("", nrow(con$dist_max))),
                                    con$dist_max))
  
  #### * cumul - Cumulée ####
  ## Statistiques
  dt <- copy(noint$stats_group)
  all <- copy(noint$stats)
  # Coller les tableaux ensembles
  nointtab <- rbind.fill(rbind.fill(dt), all)
  # Changer NA par "Tous"
  for(j in names(nointtab)){
    set(nointtab, which(is.na(nointtab[[j]])), j, "Tous")
  }
  # Méthode et Mesure individuelle
  nointtab <- cbind(data.table(`Méthode` = rep("Continue sans interruption", nrow(nointtab)),
                             `Mesure individuelle` = rep("", nrow(nointtab))),
                  nointtab)
  stats_tab <- rbind(stats_tab, nointtab); rm(nointtab)
  ## Distribution
  dist_tab <- rbind(dist_tab, cbind(data.table(`Méthode` = rep("Continue sans interruption", nrow(noint$dist_max)),
                                               `Mesure individuelle` = rep("", nrow(noint$dist_max))),
                                    noint$dist_max))
  
  # Résultat
  # Tri
  setorder(stats_tab, `Méthode`, `Mesure individuelle`, CatAge, Sexe)
  setorder(dist_tab, `Méthode`, `Mesure individuelle`, Valeur)
  # Modifier ")" par "["
  stats_tab[, CatAge := gsub(")", "[", CatAge)]
  
  
  #### Jours avec consommation minimum de nmed ####
  ## Statistiques
  dt <- copy(sim$stats_nmed_group)
  all <- copy(sim$stats_nmed$stats)
  # Coller les tableaux ensembles
  stats_nmed <- as.data.table(rbind.fill(rbind.fill(dt), all))
  # Changer NA par "Tous"
  for(j in names(stats_nmed)){
    set(stats_nmed, which(is.na(stats_nmed[[j]])), j, "Tous")
  }
  ## Distribution
  dist_nmed <- copy(sim$dist_nmed)
  
  # Résultat
  # Tri
  setorder(stats_nmed, CatAge, Sexe)
  # Modifier ")" par "["
  stats_nmed[, CatAge := gsub(")", "[", CatAge)]
  
  
  # Résultat final
  list(Stats_Desc = stats_tab,
       Dist = dist_tab,
       Stats_nmed = all)
  
}