pulso: Funciones Para Los Informes Pulso PUCP

Documented in tabla_pulso

# WARNING - Generated by {fusen} from /dev/flat_minimal.Rmd: do not edit by hand


#' Funcion para realizar tablas de cruces
#' 
#' @param data Base de datos para la funcion
#' @param main_var Variable principal que estara en las filas.
#' @param sub_var Variables de cruces.
#' @param titulo Es el titulo de la tabla, por default recoge la pregunta como aparece en la encuesta pero se puede modificar.
#' @import tidyverse
#' @import glue
#' @import sjlabelled
#' @import testthat
#' @import janitor
#' @import glue
#' @import lubridate
#' @import scales
#' @import Hmisc
#' @import lazyeval
#' @import plotly
#' @import ggrepel
#' @import cowplot
#' @import grid
#' @import fmsb
#' @import haven
#' @import rio
#' @import officer
#' @import officedown
#' @import sjlabelled
#' @import flextable
#' @import knitr
#' @import kableExtra
#' @import DT
#' @import gtsummary
#' @import ggpubr
#' @import paletteer
#' @import RColorBrewer
#' @import grDevices
#' @import graphics
#' @import utils
#' @return Una tabla.
#' @examples
#' 
#' # data_prueba_ruta <- system.file("data_prueba.sav", package = "pulso")
#' # data_prueba <- haven::read_sav(data_prueba_ruta)
#' # 
#' # radar<-
#' #   data_prueba %>% 
#' #   select(starts_with("q0008_")) %>% 
#' #   sjlabelled::label_to_colnames() %>%
#' #   pivot_longer(everything(), names_to = "pregunta", values_to = "numero") %>%
#' #   mutate(nombres=sjlabelled::as_label(numero)) %>% 
#' #   group_by(pregunta, numero, nombres) %>%
#' #   dplyr::summarize(Freq = n()) %>% 
#' #   group_by(pregunta) %>% 
#' #   dplyr::mutate(prop = round_half_up(Freq/sum(Freq), digits = 2),
#' #                 numero = as.character(numero),
#' #                 nombres = as.character(nombres)) %>% 
#' #   separate(pregunta, c("Servicio","group", NA),  sep=" - ") %>% 
#' #   filter(nombres!="No") %>%
#' #   select(-c(numero, nombres, Freq)) %>%
#' #   group_by(group) %>% 
#' #   pivot_wider(names_from = Servicio, values_from = prop) %>% 
#' #   mutate(
#' #    group=case_when(
#' #     group %in% "Conoce este servicio de bienestar que brinda la universidad" ~ "Lo conoce",
#' #     TRUE ~ group)
#' #   ) %>% 
#' #   ungroup()
#' # 
#' # radar.tag<-
#' #   data_prueba %>% 
#' #   select(starts_with("q0008_")) %>% 
#' #   nrow()
#' # 
#' # radar %>% 
#' #   select(group, `Servicio de Salud`, `Servicio de actividad fisica y deportes`, `Bienestar psicologico`, `Servicios Culturales`) %>% 
#' #   grafico_radar(polygonfill = FALSE,
#' #          grid.label.size = 3,
#' #          axis.label.size = 3,
#' #          group.line.width = 1,
#' #          fullscore = as.numeric(rep(1,ncol(.)-1))
#' #          ) + 
#' #   
#' #   labs(caption = "Elaborado por Pulso PUCP",
#' #        tag = glue("N=",radar.tag)) +
#' #   
#' #   theme(legend.title = element_blank(),legend.position = "bottom",legend.text = element_text(size=10, face = "bold",family="sans"),legend.key.height = unit(.2, "cm"),
#' #         plot.caption = element_text(face = "italic",family="sans"),plot.margin = unit(c(0,0,1,0),"cm"),plot.tag = element_text(size = 8, color="grey40"),plot.tag.position = "bottomleft",
#' #         
#' #         text = element_text(size = 9, color="#002060",family="sans"),
#' #         ) +
#' #   guides(color=guide_legend(nrow = 2, byrow = TRUE)) +
#' #   coord_equal(clip="off")
#' 
#' 
#' @export

tabla_pulso<-function(data, main_var=NULL, sub_var=NULL, filtrar=TRUE, titulo=titulo1){
  
  #switch
  #switch_main_var
  switch_sub_var <- tidyselect::eval_select(enquo(sub_var), data[unique(names(data))])
  switch_sub_var <- names(switch_sub_var)
  switch_sub_var <- switch_sub_var  %>% table() %>% sum() %>% as.numeric()
  
  #switch_main_var
  switch_main_var <- tidyselect::eval_select(enquo(main_var), data[unique(names(data))])
  switch_main_var <- names(switch_main_var)
  switch_main_var <- switch_main_var  %>% table() %>% sum() %>% as.numeric()
  
  #titulo de la tabla
  titulo1<-
    data %>%
    select({{main_var}}) %>%
    get_label() %>%
    unique()
  
  #labels
  pop<-
    data %>% 
    select({{main_var}}) %>% 
    names()
  
  labels<-
    tibble(
      numero=if(is.numeric(unlist(sjlabelled::get_values(data[,pop]), use.names = FALSE)) ){as.character(unlist(sjlabelled::get_values(data[,pop]), use.names = FALSE))} else {NA},
      nombres=unlist(sjlabelled::get_labels(data[pop]), use.names = FALSE),
    )
  
  #1. opción múltiple sin cruce
  if (switch_main_var == 1 & switch_sub_var == 0){
    
    t0<-data %>%
      filter({{filtrar}}) %>% 
      select({{main_var}}) %>%
      drop_na() %>% #se van los filtrados
      mutate(across(everything(), ~replace(., .==0, NA))) %>% #SIN INF pasa a ser los nuevos NA
      haven::as_factor() %>%
      mutate(across(everything(), ~forcats::fct_drop(., labels[labels$numero==0, ]$nombres))) %>% #dropear categoria SIN INF de factor
      gtsummary::tbl_summary(statistic = all_categorical()~ "{p}% ({n})",
                             digits = list(everything() ~ c(2, 0)),
                             missing_text = "No sabe / No responde",
                             label = everything() ~ "") %>%
      modify_header(label ~ "") %>%
      bold_labels() %>%
      remove_row_type(variables = everything(),type = c("header")) %>% 
      modify_footnote(update = everything() ~ NA) %>% 
      as_flex_table() %>%
      add_header_lines(titulo) %>%
      add_footer_lines("% (n) \nFuente: Pulso PUCP") %>%
      italic(italic = TRUE, part = "header") %>% 
      set_table_properties(layout = "autofit") %>%
      fontsize(size = 9, part = "all") %>% 
      height(height = 0.75, part = "body")
    
    t0
    
  }else
    
    #2. opción múltiple con cruce
    if (switch_main_var == 1 & switch_sub_var > 0){
      
      fn_subtable <- function(data, main, sub){
        data %>%
          filter({{filtrar}}) %>% 
          dplyr::select({{main}},{{sub}}) %>%
          drop_na() %>% #se van los filtrados
          mutate(across(everything(), ~replace(., .==0, NA))) %>% #SIN INF pasa a ser los nuevos NA
          haven::as_factor() %>%
          mutate(across(everything(), ~forcats::fct_drop(., labels[labels$numero==0, ]$nombres))) %>% #dropear categoria SIN INF de factor
          gtsummary::tbl_summary(
            by = {{sub}},
            statistic = gtsummary::all_categorical()~ "{p}% ({n})",
            digits = list(dplyr::everything() ~ c(2, 0)),
            missing_text = "No sabe / No responde",
            label = everything() ~ "") %>%
          remove_row_type(variables = everything(),type = c("header")) %>% 
          modify_footnote(update = everything() ~ NA)
        
      }
      
      #main var
      main_var <- rlang::enexpr(main_var)# 1. Capture `list(...)` call as expression
      
      #subvar
      sub_var <- tidyselect::eval_select(enquo(sub_var), data[unique(names(data))])
      sub_var <- names(sub_var)
      sub_var1 <- rlang::syms(sub_var)
      
      #tbl main var
      t0 <- data %>%
        filter({{filtrar}}) %>% 
        dplyr::select({{main_var}}) %>%
        drop_na() %>% #se van los filtrados
        mutate(across(everything(), ~replace(., .==0, NA))) %>% #SIN INF pasa a ser los nuevos NA
        haven::as_factor() %>%
        mutate(across(everything(), ~forcats::fct_drop(., labels[labels$numero==0, ]$nombres))) %>% #dropear categoria SIN INF de factor
        gtsummary::tbl_summary(statistic = gtsummary::all_categorical() ~ "{p}% ({n})",
                               digits = list(dplyr::everything() ~ c(2, 0)),
                               missing_text = "No sabe / No responde",
                               label = everything() ~ "") %>%
        gtsummary::modify_header(label ~ "") %>%
        gtsummary::bold_labels() %>%
        remove_row_type(variables = everything(),type = c("header")) %>% 
        modify_footnote(update = everything() ~ NA)
      
      #tbl sub_var1
      sub_tables <- purrr::map(sub_var1, ~fn_subtable(data = data, main = main_var, sub = .x))
      
      #titulos variables cruce
      sub_var_labels<-
        data %>%
        select(sub_var) %>%
        get_label()
      
      #merge
      tbls <-  c(list(t0), sub_tables) %>%
        gtsummary::tbl_merge(tab_spanner = c("**Total**", paste0("**",sub_var_labels,"**"))) %>%
        bold_labels() %>%
        as_flex_table() %>%
        add_header_lines(titulo) %>%
        add_footer_lines("% (n) \nFuente: Pulso PUCP") %>%
        italic(italic = TRUE, part = "header") %>% 
        set_table_properties(layout = "autofit") %>%
        fontsize(size = 9, part = "all") %>% 
        height(height = 0.75, part = "body")
      
      tbls
      
    }else
      
      #3. respuesta múltiple sin cruce
      if (switch_main_var > 1 & switch_sub_var == 0){
        
        tbl<-data %>%
          filter({{filtrar}}) %>% 
          select({{main_var}}) %>%
          sjlabelled::as_label() %>%
          gtsummary::tbl_summary(
            statistic = all_categorical() ~ "{p_nonmiss}% ({n})",
            digits = list(dplyr::everything() ~ c(2, 0)),
            missing = "no",
            label = everything() ~ "") %>%
          modify_footnote(update = everything() ~ NA) %>%
          remove_row_type(-1) %>%
          modify_header(label ~ "") %>%
          bold_labels() %>%
          remove_row_type(variables = everything(),type = c("header")) %>% 
          as_flex_table() %>%
          add_header_lines(titulo) %>%
          add_footer_lines("Fuente: Pulso PUCP") %>%
          italic(italic = TRUE, part = "header") %>% 
          set_table_properties(layout = "autofit") %>%
          fontsize(size = 9, part = "all") %>% 
          height(height = 0.75, part = "body")
        
        tbl
        
      }else
        
        #4. respuesta múltiple con cruce
        if(switch_main_var > 1 & switch_sub_var > 0){
          
          fn_subtable <- function(data, main, sub){
            data %>%
              filter({{filtrar}}) %>% 
              dplyr::select({{main}},{{sub}}) %>%
              sjlabelled::as_label() %>%
              gtsummary::tbl_summary(
                by = {{sub}},
                statistic = all_categorical() ~ "{p_nonmiss}% ({n})",
                digits = list(dplyr::everything() ~ c(2, 0)),
                missing = "no",
                label = everything() ~ "") %>%
              modify_footnote(update = everything() ~ NA) %>%
              remove_row_type(-1) %>%
              modify_header(label ~ "") %>%
              bold_labels() %>%
              remove_row_type(variables = everything(),type = c("header"))
            
          }
          
          #subvar
          sub_var <- tidyselect::eval_select(enquo(sub_var), data[unique(names(data))])
          sub_var <- names(sub_var)
          sub_var1 <- rlang::syms(sub_var)
          
          #tbl main var
          t0 <-data %>%
            filter({{filtrar}}) %>% 
            select({{main_var}}) %>%
            sjlabelled::as_label() %>%
            gtsummary::tbl_summary(
              statistic = all_categorical() ~ "{p_nonmiss}% ({n})",
              digits = list(dplyr::everything() ~ c(2, 0)),
              missing = "no",
              label = everything() ~ "") %>%
            modify_footnote(update = everything() ~ NA) %>%
            remove_row_type(-1) %>%
            modify_header(label ~ "") %>%
            bold_labels() %>%
            remove_row_type(variables = everything(),type = c("header"))
          
          #tbl sub_var1
          sub_tables <- purrr::map(sub_var1, ~fn_subtable(data = data, main = main_var, sub = .x))
          
          #titulos variables cruce
          sub_var_labels<-
            data %>%
            select(sub_var) %>%
            get_label()
          
          #merge
          tbls <-  c(list(t0), sub_tables) %>%
            gtsummary::tbl_merge(tab_spanner = c("**Total**", paste0("**",sub_var_labels,"**"))) %>%
            bold_labels() %>% 
            as_flex_table() %>%
            add_header_lines(titulo) %>%
            add_footer_lines("% (n) \nFuente: Pulso PUCP") %>%
            italic(italic = TRUE, part = "header") %>% 
            set_table_properties(layout = "autofit") %>%
            fontsize(size = 9, part = "all") %>% 
            height(height = 0.75, part = "body")
          
          tbls
          
          
        }else
          
        {return("Error. Necesitas proporcionar al menos una variable.")}
  
}
#