R/table_freq_cross_weighted.R

In AlexisMayer/toolbox:

#' Cette fonction permet de faire des tris à plats pondérés
#'
#' @param lst output tris croisés
#' @param x liste des variables 
#' @export
#' @examples 
#' lst = sapply(seq_along(dat), function(x) table.freq.cross.weighted(dat, x, "pond"), simplify = F)

# Fonction de tri croisé pondéré
table.freq.cross.weighted = function(data, var, crossvar, pond){
  # Select columns
  dat = data %>% 
    select_(.dots = c(crossvar, pond, var))
  
  # Tris
  lst = sapply(c(1:ncol(dat))[-c(1,2)], function(x) {
      descr::crosstab(dat[[x]], dat[[1]], weight = dat[[2]], prop.c = TRUE, plot = FALSE, format = "SPSS")$prop.col
  }, simplify = F)
  
  # Test chi2
  lst_chi = sapply(c(1:ncol(dat))[-c(1,2)], function(x) {
     tryCatch({
        tb = descr::crosstab(dat[[x]], dat[[1]], weight = dat[[2]], prop.c = TRUE, plot = FALSE, format = "SPSS", chisq = TRUE)$CST
        # Collect them
        res = tribble(
           ~"value", ~"p.value", 
           tb$statistic, tb$p.value
        )
     }, error = function(cond) return(NA))
  }, simplify = F) %>% 
     mapply(`[<-`, ., 'variable', value = c(1:ncol(dat))[-c(1,2)], SIMPLIFY = FALSE) %>% 
     rbind_all() %>% 
     select(variable, value, p.value)
  
  # Merge 
  lst = cbind(lst[[1]] * 100,"Chi" = c(lst_chi[1,3], rep(NA, nrow(lst[[1]])))) %>% 
    as.data.frame() %>% 
    rownames_to_column(var) %>% 
    as_tibble %>%  
    mutate_if(is.list, stringi::stri_c_list) 
  
  # Output
  return(lst)
}