R/tabprov.R

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

tabx <- function(dfx, tri){
  #On supprime les données manquantes dans la variable de tri
  #dfx <- dfx %>% 
  #filter(!is.na({{tri}}))
  #
  export = FALSE
  ka <- TRUE
  lab = "zz"
  titre = "titre"
  tabx <- NULL
  trix <- enquo(tri)
  vv <- quo_name(trix)
  triz <- dfx[vv]
  triz <- triz[[1]]
  print(triz)  
  for (ll in 1:length(dfx)){
    varx <- dfx[,ll]
    varx <- varx[[1]]
    nom <- names(dfx)[ll]
    print(nom)
    if (nom != vv){
      if (is.numeric(varx)){ # Variables numériques
        lig <- lignum(nom,varx,triz, kk = ka)
        tabx <- rbind(tabx,lig)
      } else { # Variables factorielles
        lig <- ligff(nom,varx,triz, kk = ka)
        tabx <- rbind(tabx,lig)
      }
    }
  }
  # Export
  if (export) {
    nomcsv <- paste0(titre,"_export_comparatif.csv")
    write.csv(tabx,nomcsv)
  }
  # Création tableaux
  ltit <- c(" ",levels(triz),"p")
  if (ka){
    kable(tabx, 
          row.names = FALSE, 
          col.names = ltit, 
          caption = titre, 
          label = lab, 
          escape = FALSE)
  } %>% 
    kable_styling(bootstrap_options = "striped", full_width = FALSE,
                  position = "center")
  else{
    if (longt == FALSE) {
      xx <- xtable(as.matrix(tabx), caption = titre, label = lab)
      colnames(xx) <- ltit
      print(xx,
            include.colnames = TRUE,
            floating = TRUE,
            booktabs = TRUE,
            include.rownames = FALSE,
            sanitize.text.function = function(x){x}
      )
    }
    else{
      xx <- xtable(as.matrix(tabx))
      ttit <- paste0("}&\\text{",levels(triz),collapse = "")
      ttit <- paste0("{ ",ttit,"}&p\\\\",collapse = "")
      print(xx,
            align = "lccc",
            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(ttit,"
                                             \\midrule
                                             \\endfirsthead
                                              "
                                               ,ttit,
                                               "
                                             \\endhead
                                             \\bottomrule
                                             \\endfoot
                                             \\bottomrule
                                             \\caption{",titre,"}
                                             \\label{",lab,"}
                                             \\endlastfoot
                                             ")))
    }
  }
}