R/tabdesc.R

In philippemichel/thesisph: Tout ce qu'il faut pour debuter un travail simple

#' Tableau descriptif d'une population
#'
#' @param df data.frame
<<<<<<< HEAD
#' @param tlong TRUE : Tableau simple, FALSE : longtable
#' @param capt Titre du tableau - "Description de la population" par defaut
#' @param lab Label - "tabd"  par défaut
#' @param export si TRUE : cree un cvs. (FALSE par defaut)
#' @param ka si TRUE : sortie via kable sinon xtable (FALSE  par defaut)
=======
#' @param tlong TRUE : Tableau simple, FALSE : longtable (for laTeX output)
#' @param capt Titre du tableau - "Description de la population" par defaut
#' @param lab Label - "tabd"  par défaut
#' @param export si TRUE : cree un cvs. (FALSE par defaut)
#' @param ka si TRUE : sortie via kable sinon xtable (TRUE  par defaut)
>>>>>>> 42b20b896837efe579944162827a68963584f331
#'
#' @return tableau LaTex, tableau csv
#'
#' @import xtable
#' @import epiDisplay
#' @import stats
#' @import boot
#' @import kableExtra
#' @import tidyverse
#' @import knitr
#' @import stringr
#'
#' @examples tabdescph(iris, tlong = TRUE, capt = "Titre du tableau", lab = "tabd", export = FALSE, ka = TRUE)
#' @export
tabdescph<- function(df, 
                     tlong = TRUE,
                     capt = "Description de la population",
                     lab = "tabd", 
                     export = FALSE, 
<<<<<<< HEAD
                     ka  = FALSE){
  ll <- length(names(df))
  tabb <- matrix(nrow=0,ncol=3)
  for (i in 1:length(df)){
    varx <- df[,i]
    if (class(varx) != "Date" && length(na.omit(varx)) > 0){
    ld <- length(na.omit(varx))
    if (is.factor(varx) == TRUE) {
      if (length(levels(varx))==2) {
        #Variables qualitatives -- 2 niveaux
        if (levels(varx)[1] == "non") { # Pour afficher les "oui"
          varx <- relevel(varx,"oui")
=======
                     ka  = TRUE){
  tabb <- matrix(nrow = 0, ncol = 3)
  for (i in 1:dim(df)[2]) {
    varx <- na.omit(df[, i])
    ld <- length(varx)
    namd <- names(df[i]) # nom de la variable
    if (class(varx) != "Date" && ld > 0) {
      # Variable factorielle
      if (is.factor(varx)) {
          ligd <- c(namd, " ", " ")
          tabb <- rbind(tabb, ligd)
          lti <- levels(varx)
          rdf <- table(varx)
          rtp <- prop.table(rdf)
          for (j in 1:length(lti)) {
            esp <- ifelse(ka, "&nbsp;", "~")
            esp <- stringr::str_c(rep(esp, 6), collapse = "")
            nlig <- paste0(esp, lti[j])
            cf <- transangph(rdf[j], ld)
            ligd <- c(nlig, cf$litx)
            tabb <- rbind(tabb, ligd)
>>>>>>> 42b20b896837efe579944162827a68963584f331
        }
      }
      else {
<<<<<<< HEAD
        # Variables qualitatives -- niveaux multiples
        ligd <- c(names(df[i])," "," ")
        # print(ligd)
        tabb <- rbind(tabb,ligd)
        dfi <- na.omit(varx)
        lti <- levels(dfi)
        rdf <- table(dfi)
        # print(rdf)
        rtp <- prop.table(rdf)
        for (j in 1:length(lti)){
          if (ka){
            nlig <- paste0("&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;",lti[j])
          } else{
          nlig <- paste0("~~~~~~",lti[j])
          }
          cf <- transangph(rdf[j],ld)
          ligd <- c(nlig,cf$litx)
          tabb <- rbind(tabb,ligd)
        }
=======
        # Variables quantitatives
        lig1 <- lms(varx)
        bornes <- moypciph(varx, ci = 95)
        tbf <- paste0("[", bornes[1], " ; ", bornes[2], "]")
        ligb <- c(names(df[i]), lig1, tbf)
        tabb <- rbind(tabb, ligb)
>>>>>>> 42b20b896837efe579944162827a68963584f331
      }
    }
  }
<<<<<<< HEAD
  #
  # Ecriture du tableau
  #
  if (export) {
    write.csv(tabb,"export_descriptif.csv")
  }
  if (ka){
    kable(tabb, row.names = FALSE, 
          col.names=c("","moy ± et  N/total (%)","IC 95 %"), 
          escape = F) %>% 
      kable_styling(bootstrap_options = "striped", full_width = FALSE,
                    position = "center")
  }
  else{
  #
  if(tlong){
    xtable(tabb) %>%
      print( tabular.environment='longtable',
             include.colnames=FALSE,
             floating=FALSE,
             booktabs=TRUE,
             hline.after=-1,
             include.rownames=FALSE,
             sanitize.text.function = function(x){x},
             add.to.row = list(pos = list(0),
                               command = paste0("
=======
  if (export) {
    nomexp <- paste0("export_", lab, ".csv")
    write.csv(tabb, nomexp)
  }
  if (ka) {
    kable(
      tabb,
      row.names = FALSE,
      col.names = c("", "moy ± et  N/total (%)", "IC 95 %"),
      escape = FALSE
    ) %>%
      kableExtra::kable_styling(
        bootstrap_options = "striped",
        full_width = FALSE,
        position = "center"
      )
  }
  else{
    #
    if (tlong) {
      xtable(tabb) %>%
        print(
          tabular.environment = 'longtable',
          include.colnames = FALSE,
          floating = FALSE,
          booktabs = TRUE,
          hline.after = -1,
          include.rownames = FALSE,
          sanitize.text.function = function(x) {
            x
          },
          add.to.row = list(
            pos = list(0),
            command = paste0(
              "
>>>>>>> 42b20b896837efe579944162827a68963584f331
                                                &\\mbox{moyenne ± écart type}&\\mbox{IC 95 \\%}\\\\
                                                &\\mbox{n/total (\\%)}&\\\\
                                                \\midrule
                                                \\endfirsthead
                                                \\midrule
                                                &\\mbox{moyenne ± écart type}&\\mbox{IC 95 \\%}\\\\
                                                &\\mbox{n/total (\\%)}&\\\\
                                                \\midrule
                                                \\endhead
                                                \\bottomrule
                                                \\endfoot
                                                \\bottomrule
                                                \\caption{",
              capt,
              "}
                                                \\label{",
              lab,
              "}
                                                \\endlastfoot
                                                "
            )
          )
        )
    }
    else{
      xtable(tabb, caption = capt, label = lab) %>%
        print(
          include.colnames = FALSE,
          include.rownames = FALSE,
          sanitize.text.function = function(x) {
            x
          },
          booktabs = TRUE,
          add.to.row = list(
            pos = list(0),
            command =
              "&\\mbox{moyenne ± écart type}&\\mbox{IC 95 \\%}\\\\
                              &\\mbox{n/total (\\%)}&\\\\"
          )
        )
    }
  }
}