In aito123/pulso: Funciones Para Los Informes Pulso PUCP

Funciones de Pulso PUCP

Este paquete fue creado por Santiago Sotelo.

#Paquetes necesarios
pacman::p_load(
    #test
    pkgload, pkgdown, testthat,
    #data tools
    tidyverse, janitor, glue, lubridate, scales, Hmisc,lazyeval,
    #Gráficos
    plotly, ggrepel, cowplot, grid, fmsb, 
    #importar / exportar
    haven, rio, officer, officedown,
    #Etiquetas
    sjlabelled,
    #tablas
    flextable, knitr, kableExtra, DT, gtsummary,
    #Temas
    ggpubr,
    #Colores
    paletteer, RColorBrewer
    )

data_prueba_ruta <- system.file("data_prueba.sav", package = "pulso")
data_prueba <- haven::read_sav(data_prueba_ruta)
# Make your dataset file available to the current Rmd
load_all(path = here::here(), export_all = FALSE)

Barra simple

#' Funcion para realizar un grafico de barras simple.
#' 
#' @param data Base de datos para la funcion
#' @param var Variable para el grafico de barras simple
#' @param filtrar Por default TRUE que significa ningún filtro, si se quiere filtrar por una variable especificar la variable y el valor a filtrar (ej: filtrar = q0002 == 1 que significa filtrar la base para que aparezcan solo los casos que tienen en la pregunta q0002 el valor de 1).
#' @param ordenado Por default es TRUE, significa que ordena las barras de menor a mayor, cambiar a FALSE para dejarlas en el orden original.
#' @param frecuencia Por default es FALSE, cambiar a TRUE para visualizar los resultados en frecuencias y no en porcentajes.
#' @param porcentaje Por default es TRUE, cambiar a FALSE para visualizar los resultados de porcentajes sin el simbolo %.
#' @param ultimo Por default es NULL, escribir entre comillas la palabra que quieres que vaya al final de las barras (ej: ultimo="Otros")
#' @param max.limit Por default es 1, es el limite máximo del eje x. 1=100 cuando son resultados en porcentajes (ej: max.limit=0.75 significa maximo 75%). Aunque el porcentaje esté en FALSE, el max.limit debe ser tratado como si 1.00 fuera el maximo y no como si 100 fuera el maximo.
#' @param color Por default es color azul que es "#B0D597" en notacion hexagesimal. Buscar colores hex para más información. También permite colores grabados en R como "red".
#' @param ext.label Por default es 30, a menor el número menor espacio para el texto de las etiquetas.
#' @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 Un grafico de barras simple.
#' @examples
#' @export

barra_simple<- function(data, var, filtrar=TRUE, ordenado=TRUE, frecuencia=FALSE,  porcentaje=TRUE, ultimo=NULL, max.limit=1, color = "#B0D597", ext.label=30){

  total<-nrow(data)

  if(isTRUE(ordenado)) {

    tablon<-data %>%
      filter({{filtrar}}) %>% 
      sjlabelled::as_label() %>%
      count(var = fct_rev(fct_infreq(factor({{var}}))) ) %>%
      mutate(pct = prop.table(n))

  } else {

    tablon<-data %>%
      filter({{filtrar}}) %>% 
      sjlabelled::as_label() %>%
      count(var = fct_rev(factor({{var}}))) %>%
      mutate(pct = prop.table(n))

  }

  if(isTRUE(frecuencia)) {

    tablon %>%
      #grafico
      ggplot(aes(x = fct_relevel(var, ultimo), y = n ) ) +
      geom_bar(stat='identity', fill = color, width = 0.6) +

      #Etiqueta = -7%
      geom_text(aes(label = ifelse(pct < 0.07, n, "") ),
                position = position_dodge(width = .9),
                vjust = 0.2,
                hjust = -0.2,
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      #Etiqueta = El resto
      geom_text(aes(label = ifelse(pct >= 0.07, n, "") ),
                position = position_stack(vjust = 0.5),
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      scale_x_discrete(labels = wrap_format(ext.label)) +
      scale_y_continuous(labels=number_format(accuracy =1), limits = c(0, if(max.limit==1){max(tablon$n) + round_half_up(max(tablon$n)/3)} else {max.limit} )) +
      coord_flip() +
      theme_pubr() +
      labs(subtitle = "Resultados en frecuencias",
           caption = "Elaborado por Pulso PUCP",
           tag = if(sum(tablon$n) == total){glue("N=",sum(tablon$n))}else{glue("N=",sum(tablon$n),"/",total)}) +
      theme(text = element_text(size = 9, color="#002060"),

            plot.subtitle = element_text(size = 10, color="#002060"),
            plot.title.position = "plot",

            plot.caption = element_text(face = "italic"),

            plot.tag = element_text(size = 8, color="grey40"),
            plot.tag.position = "topright",

            axis.title = element_blank(),
            axis.text = element_text(color="#002060"),
            axis.ticks = element_line(color="#002060"),
            axis.line = element_line(color="#002060", size = 0.5) )

  } else {

    tablon %>%
      #grafico
      ggplot(aes(x = fct_relevel(var, ultimo), y = pct ) ) +
      geom_bar(stat='identity', fill = color, width = 0.6) +

      #Etiqueta = -7%
      geom_text(aes(label = ifelse(pct < 0.07, if(isTRUE(porcentaje)){scales::percent(pct, accuracy = 1)} else {scales::number(pct, scale = 100)} , "") ),
                position = position_dodge(width = .9),
                vjust = 0.2,
                hjust = -0.2,
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      #Etiqueta = El resto
      geom_text(aes(label = ifelse(pct >= 0.07, if(isTRUE(porcentaje)){scales::percent(pct, accuracy = 1)} else {scales::number(pct, scale = 100)}, "") ),
                position = position_stack(vjust = 0.5),
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      scale_x_discrete(labels = wrap_format(ext.label)) +
      scale_y_continuous(labels = if(isTRUE(porcentaje)) {~scales::percent(.x, accuracy = 1)} else {~scales::number(.x, scale = 100)}, limits = if(isTRUE(porcentaje)) {c(0, max.limit)} else { c(0, max.limit )} ) +
      coord_flip() +
      theme_pubr() +
      labs(subtitle = if(isTRUE(porcentaje)){waiver()} else {"Resultados en porcentajes"},
           caption = "Elaborado por Pulso PUCP",
           tag = if(sum(tablon$n) == total){glue("N=",sum(tablon$n))}else{glue("N=",sum(tablon$n),"/",total)}) +
      theme(text = element_text(size = 9, color="#002060"),

            plot.subtitle = element_text(size = 10, color="#002060"),
            plot.title.position = "plot",

            plot.caption = element_text(face = "italic"),

            plot.tag = element_text(size = 8, color="grey40"),
            plot.tag.position = "topright",

            axis.title = element_blank(),
            axis.text = element_text(color="#002060"),
            axis.ticks = element_line(color="#002060"),
            axis.line = element_line(color="#002060", size = 0.5) )

  }

}

# data_prueba %>% 
#   barra_simple(gedad, ordenado=FALSE)

# test_that("barra_simple works", {
#   expect_error(data_prueba %>%
#                  barra_simple(gedad, ordenado=FALSE), regexp = NA)
# })

Barra multiple

#' Funcion para realizar un grafico de barras multiple
#' 
#' @param data Base de datos para la funcion
#' @param ... Variables para el grafico de barras multiple
#' @param filtrar Por default TRUE que significa ningún filtro, si se quiere filtrar por una variable especificar la variable y el valor a filtrar (ej: filtrar = q0002 == 1 que significa filtrar la base para que aparezcan solo los casos que tienen en la pregunta q0002 el valor de 1).
#' @param abierta Por default abierta es FALSE, es necesario cambiarla a TRUE cuando se trabaja con una pregunta abierta lo cual tendra un impacto en las etiquetas.
#' @param frecuencia Por default es FALSE, cambiar a TRUE para visualizar los resultados en frecuencias y no en porcentajes.
#' @param porcentaje Por default es TRUE, cambiar a FALSE para visualizar los resultados de porcentajes sin el simbolo %.
#' @param ultimo Por default es NULL, escribir entre comillas la palabra que quieres que vaya al final de las barras (ej: ultimo="Otros")
#' @param max.limit Por default es 1, es el limite máximo del eje x. 1=100 cuando son resultados en porcentajes (ej: max.limit=0.75 significa maximo 75%). Aunque el porcentaje esté en FALSE, el max.limit debe ser tratado como si 1.00 fuera el maximo y no como si 100 fuera el maximo.
#' @param color Por default es color azul que es "#B0D597" en notacion hexagesimal. Buscar colores hex para más información. También permite colores grabados en R como "red".
#' @param ext.label Por default es 30, a menor el número menor espacio para el texto de las etiquetas.
#' @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 Un grafico de barras múltiple
#' @examples
#' @export

barra_multiple<-function(data, ..., filtrar=TRUE, abierta=FALSE, frecuencia=FALSE, porcentaje=TRUE, ultimo=NULL, max.limit=1, color = "#B0D597", ext.label=30){

  total<-nrow(data)

  tag<-
    data %>%
    filter({{filtrar}}) %>% 
    sjlabelled::as_label() %>%
    select(...) %>% nrow()

  tablon<-
    data %>%
      filter({{filtrar}}) %>% 
      #tabla
      sjlabelled::as_label() %>%
      select(...) %>%
      pivot_longer(everything(), names_to = "pregunta", values_to = "nombres") %>%
      group_by(pregunta, nombres) %>%
      dplyr::summarize(Freq = n()) %>%
      group_by(pregunta) %>%
      dplyr::mutate(pct = round_half_up(Freq/sum(Freq), digits = 2),
                    nombres = as.character(nombres)) %>%
      drop_na(nombres) %>%
      filter(!(nombres %in% "")) %>%
      ungroup()

  if(isTRUE(frecuencia)) {

     tablon %>%  
      #grafico
      ggplot(aes(x =fct_relevel( fct_reorder(if(isTRUE(abierta)){ pregunta }else{ nombres }, pct, min), ultimo), y = Freq) ) +
      geom_bar(stat='identity', fill = color, width = 0.6) +

      #Etiqueta = -7%
      geom_text(aes(label = ifelse(pct < 0.07, Freq, "") ),
                position = position_dodge(width = .9),
                vjust = 0.2,
                hjust = -0.2,
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      #Etiqueta = El resto
      geom_text(aes(label = ifelse(pct >= 0.07, Freq, "") ),
                position = position_stack(vjust = 0.5),
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      scale_x_discrete(labels = wrap_format(ext.label)) +
      scale_y_continuous(labels=number_format(accuracy =1), limits = c(0, if(max.limit==1){max(tablon$Freq) + round_half_up(max(tablon$Freq)/3)} else {max.limit} )) +
      coord_flip() +
      theme_pubr() +
      labs(subtitle = "Resultados en frecuencias",
           caption = "Elaborado por Pulso PUCP",
           tag = if(tag == total) {glue("N=",tag)} else {glue("N=",tag,"/",total)} ) +
      theme(text = element_text(size = 9, color="#002060"),

            plot.subtitle = element_text(size = 10, color="#002060"),
            plot.title.position = "plot",

            plot.caption = element_text(face = "italic"),

            plot.tag = element_text(size = 8, color="grey40"),
            plot.tag.position = "topright",

            axis.title = element_blank(),
            axis.text = element_text(color="#002060"),
            axis.ticks = element_line(color="#002060"),
            axis.line = element_line(color="#002060", size = 0.5)
            )

  }
  else
  {

    tablon %>%  
      #grafico
      ggplot(aes(x =fct_relevel( fct_reorder(if(isTRUE(abierta)){ pregunta }else{ nombres }, pct, min), ultimo), y = pct) ) +
      geom_bar(stat='identity', fill = color, width = 0.6) +

      #Etiqueta = -7%
      geom_text(aes(label = ifelse(pct < 0.07, if(isTRUE(porcentaje)){scales::percent(pct, accuracy = 1)} else {scales::number(pct, scale = 100)} , "") ),
                position = position_dodge(width = .9),
                vjust = 0.2,
                hjust = -0.2,
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      #Etiqueta = El resto
      geom_text(aes(label = ifelse(pct >= 0.07, if(isTRUE(porcentaje)){scales::percent(pct, accuracy = 1)} else {scales::number(pct, scale = 100)}, "") ),
                position = position_stack(vjust = 0.5),
                size = 3.5,
                fontface = "bold",
                color = "#002060") +

      scale_x_discrete(labels = wrap_format(ext.label)) +
      scale_y_continuous(labels = if(isTRUE(porcentaje)) {~scales::percent(.x, accuracy = 1)} else {~scales::number(.x, scale = 100)}, limits = if(isTRUE(porcentaje)) {c(0, max.limit)} else { c(0, max.limit )} ) +
      coord_flip() +
      theme_pubr() +
      labs(subtitle = if(isTRUE(porcentaje)){waiver()} else {"Resultados en porcentajes"},
           caption = "Elaborado por Pulso PUCP",
           tag = if(tag == total) {glue("N=",tag)} else {glue("N=",tag,"/",total)} ) +
      theme(text = element_text(size = 9, color="#002060"),

            plot.subtitle = element_text(size = 10, color="#002060"),
            plot.title.position = "plot",

            plot.caption = element_text(face = "italic"),

            plot.tag = element_text(size = 8, color="grey40"),
            plot.tag.position = "topright",

            axis.title = element_blank(),
            axis.text = element_text(color="#002060"),
            axis.ticks = element_line(color="#002060"),
            axis.line = element_line(color="#002060", size = 0.5)
      )

  }
}

# data_prueba %>% 
#   filter(q0002 %in% 1) %>% 
#   barra_multiple(starts_with("q0004_0"))

# test_that("barra_multiple works", {
#   expect_error(data_prueba %>% 
#   filter(q0002 %in% 1) %>% 
#   barra_multiple(starts_with("q0004_0")), regexp = NA)
# })

Barra apilada

#' Funcion para realizar un grafico de barra apilada de 1 variable.
#' 
#' @param data Base de datos para la funcion
#' @param var Variable para el grafico de barra apilada
#' @import pkgload
#' @import pkgdown
#' @import testthat
#' @import glue
#' @import sjlabelled
#' @import testthat
#' @import tidyverse
#' @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
#' @import ggpubr
#' @import scales
#' @return Un grafico de barra apilado
#' @examples
#' @export

barra_apilada<-function(data, ..., filtrar=TRUE, ordenado=TRUE, porcentaje=TRUE, ext.label=42, base.posicion=0.35){

  switch<-
    data %>% 
    select(...) %>% 
    names() %>% 
    table() %>% 
    sum() %>% 
    as.numeric()

  if(switch %in% 1){   

    #Barra apilada de 1

    total<-
      data %>%
      filter({{filtrar}}) %>% # filtro y lógica
      select(...) %>%
      nrow() 

    tag<-
      data %>%
      filter({{filtrar}}) %>% # filtro y lógica
      select(...) %>%
      filter_all(all_vars(. != 0)) %>% #SIN INF
      nrow() 

    pop<-
      data %>% 
      select(...) %>% 
      names()

    labels<-
      tibble(
        numero=as.character(unlist(sjlabelled::get_values(data[,pop]), use.names = FALSE)),
        nombres=unlist(sjlabelled::get_labels(data[,pop]), use.names = FALSE),
      ) %>%
      filter(numero!=0)

    colores<-colorRampPalette(c("#F4B183","#FFD966", "#B0D597", "#8FC36B"))

    num_colores<-labels %>%
      nrow()

    tablon<-data %>%
      filter({{filtrar}}) %>% 
      select(...) %>% 
      rename(nombres=everything()) %>% 
      mutate(numero=nombres,
             nombres=sjlabelled::as_label(nombres)) %>% 
      drop_na(numero) %>%
      filter(numero!=0) %>%
      dplyr::group_by(numero, nombres) %>%
      dplyr::summarize(Freq = n()) %>%
      ungroup() %>%
      dplyr::mutate(prop = round_half_up(Freq/sum(Freq), digits = 2),
                    numero = as.character(numero),
                    nombres = as.character(nombres)) %>%

      full_join(labels) %>%
      mutate(across(where(is.numeric), ~replace(., is.na(.), 0))) %>%

      mutate(

        color=colores(num_colores)[as.numeric(numero)],

        total="total"
      ) %>%

      mutate(
        numero2=case_when(
          numero %in% as.character(num_colores-1) ~ as.character(num_colores),
          TRUE ~ numero),


      ) %>%
      group_by(total, numero2) %>%
      mutate(prop2=sum(prop)) %>%
      ungroup()

    tablon %>%

      #Gráfico
      ggplot(aes(total, prop, label = if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)}else{scales::number(prop, scale = 100, accuracy = 1)} )) +
      geom_col(aes(fill=factor(color, ordered = TRUE, levels = rev(colores(num_colores)) )), position = "fill", width = 0.4) +

      #Etiqueta max <7%
      geom_text(aes(y=1.05, label = ifelse((numero == (max(as.numeric(numero))) & prop < 0.07) & !(numero == (max(as.numeric(numero))) & prop == 0), if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)} else {scales::number(prop, scale = 100, accuracy = 1)}, "") ),
                size = 3.5,
                fontface = "bold",
                color = "#002060",
                family="sans") +

      #Etiqueta min <7%
      geom_text(aes(y=-0.05, label = ifelse((numero == (min(as.numeric(numero))) & prop < 0.07) & !(numero == (min(as.numeric(numero))) & prop == 0), if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)} else {scales::number(prop, scale = 100, accuracy = 1)}, "") ),
                size = 3.5,
                fontface = "bold",
                color = "#002060",
                family="sans") +

      #Etiqueta = El resto planeo usar ggrepel
      geom_text(aes(label = ifelse(!((numero == (max(as.numeric(numero))) & prop < 0.07) |
                                       (numero == (min(as.numeric(numero))) & prop < 0.07)) & !(prop == 0), if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)} else {scales::number(prop, scale = 100, accuracy = 1)}, "") ),
                position = position_stack(vjust = 0.5),
                size = 3.5,
                fontface = "bold",
                color = "#002060",
                family="sans") +

      #TOP2BOX
      geom_label(aes(y=1.2, label=ifelse(numero2 == (max(as.numeric(numero2))), if(isTRUE(porcentaje)){scales::percent(prop2, accuracy = 1)} else {scales::number(prop2, scale = 100, accuracy = 1)}, NA)),
                 size = 3.5,
                 fontface = "bold",
                 color = "#459847",
                 family="sans") +
      geom_text(y=1.2,
                label="TOP2BOX",
                size=3.5,
                nudge_x = 0.15, #hacia arriba
                fontface = "bold",
                color = "#459847",
                family="sans") +

      #N Base
      geom_text(y=1.00, 
                label=if(tag == total) {glue("N=",tag)} else {glue("N=",tag,"/",total)},
                size = 2.5, 

                hjust = 1, # a la izquierda del 100%
                nudge_x = 0.25, #hacia arriba
                # position = position_stack(vjust = 0.5),

                # vjust = 0, 
                # nudge_y = 0.5,

                color="grey40",
                family="sans") +

      #eje x y
      scale_y_continuous(labels = if(isTRUE(porcentaje)) {~scales::percent(.x, accuracy = 1)} else {~scales::number(.x, scale = 100, accuracy = 1)}, limits = c(-0.05, 1.3)) + #c(-0.05, 1.3)  c(-5, 130)) labels = scales::percent ACA PUEDE HABER PROBLEM
      scale_fill_identity(labels=str_wrap(levels(fct_reorder(tablon$nombres, tablon$numero, min)), width = 20), breaks= levels(droplevels(factor(tablon$color, ordered = TRUE, levels = colores(num_colores) ))), guide="legend") +
      coord_flip(clip="off", ylim = c(-0.05, 1.5)) +

      #temas
      ggpubr::theme_pubr() +
      labs(subtitle = if(isTRUE(porcentaje)){waiver()} else {"Resultados en porcentajes"},
           caption = "Elaborado por Pulso PUCP") +

      theme(text = element_text(size = 9, color="#002060",family="sans"),

            legend.title = element_blank(),
            legend.position = c(0.1, 0.2), #izq-der,top-down
            legend.justification = c("left"),
            legend.text = element_text(size = 7, face = "bold",family="sans"),
            legend.key.height = unit(.2, "cm"),
            legend.margin=margin(t=1, b=1), # legend.box.margin=margin(-10,-10,-10,-10),

            plot.subtitle = element_text(size = 10, color="#002060"),
            plot.title.position = "plot",

            plot.caption = element_text(face = "italic",family="sans"),
            plot.margin = unit(c(0,0,0,0),"cm"),#trbl

            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank(),
            axis.line = element_blank() ) +

      guides(fill = guide_legend(reverse=FALSE,label.position = "right", nrow = 1))

  } else {

    #Barra apilada n 

    total<-
      data %>%
      filter({{filtrar}}) %>% # filtro y lógica
      select(...) %>%
      nrow() 

    nombres_orden<-
      data %>%
      select(...)%>%
      sjlabelled::label_to_colnames() %>%
      names()

    nombres_orden<-ordered(factor(nombres_orden))

    noms<-
      data %>%
      select(...) %>%
      names()

    pop<-as.character(noms)

    labels <- tibble(
      pregunta = sort(rep(as.character(unlist(sjlabelled::get_label(data[,pop]), use.names = FALSE)), 
                          sum(nchar(unique(as.numeric(unlist(sjlabelled::get_values(data[,pop]), use.names = FALSE))))))), 

      numero = as.character(unlist(sjlabelled::get_values(data[,pop]), use.names = FALSE)), 

      nombres = unlist(sjlabelled::get_labels(data[,pop]), use.names = FALSE), ) %>% 

      filter(numero != 0)

    colores<-colorRampPalette(c("#F4B183","#FFD966", "#B0D597", "#8FC36B"))

    num_colores<-
      labels %>%
      select(nombres) %>% 
      distinct() %>% 
      nrow()

    #Tabla sin_inf
    tablon_sininf<-
      data %>%
      filter({{filtrar}}) %>% 
      select(...)%>%
      sjlabelled::label_to_colnames() %>%
      pivot_longer(everything(), names_to = "pregunta", values_to = "numero") %>%
      mutate(nombres=sjlabelled::as_label(numero)) %>%
      group_by(pregunta, numero, nombres) %>%
      drop_na(numero) %>%
      filter(numero==0) %>%
      dplyr::summarize(sin_inf = n()) %>%
      ungroup() %>% 
      select(-c(numero, nombres))

    #Tabla
    tablon<-

      data %>%
      filter({{filtrar}}) %>%
      select(...)%>%
      sjlabelled::label_to_colnames() %>%
      pivot_longer(everything(), names_to = "pregunta", values_to = "numero") %>%
      mutate(nombres=sjlabelled::as_label(numero)) %>%
      group_by(pregunta, numero, nombres) %>%
      drop_na(numero) %>%
      filter(numero!=0) %>%
      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)) %>%

      full_join(labels) %>%
      mutate(across(where(is.numeric), ~replace(., is.na(.), 0))) %>%

      mutate(

        color=colores(num_colores)[as.numeric(numero)],

      ) %>%

      mutate(
        numero2=case_when(
          numero %in% as.character(num_colores-1) ~ as.character(num_colores),
          TRUE ~ numero),


      ) %>%
      group_by(pregunta, numero2) %>%
      mutate(prop2=sum(prop)) %>%
      ungroup() %>% 
      full_join(tablon_sininf) %>%
      mutate(across(where(is.numeric), ~replace(., is.na(.), 0))) %>% 
      mutate(base_total=case_when(
        sin_inf == 0 ~ glue("N={total}"),
        sin_inf != 0 ~ glue("N={total-sin_inf}/{total}"),
        TRUE ~ ""

      ))

    tablon %>%

      #Gráfico
      ggplot(aes(x=if(isTRUE(ordenado)){fct_reorder2(pregunta, numero, -prop2)}else{fct_rev(factor(pregunta, levels = nombres_orden))}, y=prop, label = if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)}else{scales::number(prop, scale = 100, accuracy = 1)} )) +
      geom_col(aes(fill=factor(color, ordered = TRUE, levels = rev(colores(num_colores)) )), position = "fill", width = 0.6) +

      #Etiqueta max <7%
      geom_text(aes(y=1.05, label = ifelse((numero == (max(as.numeric(numero))) & prop < 0.07) & !(numero == (max(as.numeric(numero))) & prop == 0), if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)} else {scales::number(prop, scale = 100, accuracy = 1)}, "") ),
                size = 3.5,
                fontface = "bold",
                color = "#002060",
                family="sans") +

      #Etiqueta min <7%
      geom_text(aes(y=-0.05, label = ifelse((numero == (min(as.numeric(numero))) & prop < 0.07) & !(numero == (min(as.numeric(numero))) & prop == 0), if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)} else {scales::number(prop, scale = 100, accuracy = 1)}, "") ),
                size = 3.5,
                fontface = "bold",
                color = "#002060",
                family="sans") +

      #Etiqueta = El resto planeo usar ggrepel
      geom_text(aes(label = ifelse(!((numero == (max(as.numeric(numero))) & prop < 0.07) |
                                       (numero == (min(as.numeric(numero))) & prop < 0.07)) & !(prop == 0), if(isTRUE(porcentaje)){scales::percent(prop, accuracy = 1)} else {scales::number(prop, scale = 100, accuracy = 1)}, "") ),
                position = position_stack(vjust = 0.5),
                size = 3.5,
                fontface = "bold",
                color = "#002060",
                family="sans") +

      #TOP2BOX
      geom_label(aes(y=1.2, label=ifelse(numero2 == (max(as.numeric(numero2))), if(isTRUE(porcentaje)){scales::percent(prop2, accuracy = 1)} else {scales::number(prop2, scale = 100, accuracy = 1)}, NA)),
                 size = 3.5,
                 fontface = "bold",
                 color = "#459847",
                 family="sans") +
      # annotate("text", label="TOP2BOX", x=as.numeric(count(as.data.frame(unique(tablon$pregunta)))), y = 1.2, vjust = -3,
      #          size = 3.5,
      #          fontface = "bold",
      #          color = "#459847",
      #          family="sans") +
      geom_text(x=as.numeric(count(as.data.frame(unique(tablon$pregunta)))),
                y=1.2,
                label="TOP2BOX",
                size=3.5,
                vjust = -3,
                #nudge_x = 0.3, #hacia arriba
                fontface = "bold",
                color = "#459847",
                family="sans") +

      #N Base
      geom_text(y=1.00, 
                aes(label=base_total),
                size = 2.5, 

                hjust = 1, # a la izquierda del 100%
                nudge_x = base.posicion, #hacia arriba
                # position = position_stack(vjust = 0.5),

                # vjust = 0, 
                # nudge_y = 0.5,

                color="grey40",
                family="sans") +

      #eje x y
      scale_x_discrete(labels = scales::wrap_format(ext.label)) +
      scale_y_continuous(labels = if(isTRUE(porcentaje)) {~scales::percent(.x, accuracy = 1)} else {~scales::number(.x, scale = 100, accuracy = 1)}, limits = c(-0.05, 1.3)) +
      scale_fill_identity(labels=str_wrap(levels(fct_reorder(tablon$nombres, tablon$numero, min)), width = 20), breaks= levels(droplevels(factor(tablon$color, ordered = TRUE, levels = colores(num_colores)))), guide="legend") +
      coord_flip(clip="off", ylim = c(-0.05, 1.3)) +

      #temas
      ggpubr::theme_pubr() +
      labs(subtitle = if(isTRUE(porcentaje)){waiver()} else {"Resultados en porcentajes"},
           caption = "Elaborado por Pulso PUCP" ) +

      theme(text = element_text(size = 9, color="#002060",family="sans"),

            legend.title = element_blank(),
            legend.position = c(0.1, -0.05), #izq-der,top-down,
            legend.text = element_text(size = 7, face = "bold",family="sans"),
            legend.key.height = unit(.2, "cm"),

            plot.subtitle = element_text(size = 10, color="#002060"),
            plot.title.position = "plot",

            plot.caption = element_text(face = "italic",family="sans"),
            plot.margin = unit(c(t=0,r=0,b=1,l=0),"cm"),

            axis.title = element_blank(),
            axis.text = element_text(color="#002060"),
            axis.text.y = element_text(hjust=0.5),
            axis.text.x = element_blank(),
            axis.ticks = element_blank(),
            axis.line = element_blank() ) +

      guides(fill = guide_legend(reverse=FALSE,label.position = "right", nrow = 1))

  }

}

# data_prueba_ruta <- system.file("data_prueba.sav", package = "pulso")
# data_prueba <- haven::read_sav(data_prueba_ruta)
# 
# data_prueba %>% 
#   filter(q0002 %in% 1) %>% 
#   barra_apilada_1(q0003_0002)

# test_that("barra_apilada_1 works", {
#   expect_error(data_prueba %>% 
#   filter(q0002 %in% 1) %>% 
#   barra_apilada_1(q0003_0002), regexp = NA)
# })

Grafico donut

#' Funcion para realizar un grafico donut.
#' 
#' @param data Base de datos para la funcion
#' @param var Variable para gráfico donut
#' @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 Un grafico donut
#' @examples
#' @export

grafico_donut<- function(data, var, filtrar=TRUE, paleta=1, direction=1) {

  total<-
    data %>% 
    nrow()

  tag<-
    data %>%
    filter({{filtrar}}) %>% 
    sjlabelled::as_label() %>%
    select({{var}}) %>%
    nrow()

  data %>%
    filter({{filtrar}}) %>% 
    sjlabelled::as_label() %>%
    group_by({{var}}) %>%
    count() %>%
    rename(count=n) %>%
    ungroup() %>%
    mutate(prop=paste0(round_half_up(count/sum(count), digits = 2)*100, "%"),
           # Compute percentages
           fraction=count/sum(count),
           # Compute the cumulative percentages (top of each rectangle)
           ymax=cumsum(fraction),
           # Compute the bottom of each rectangle
           ymin=c(0, head(ymax, n=-1)),
           # Compute label position
           labelPosition=(ymax + ymin) / 2,
           # Compute a good label
           label=paste0({{var}}, "\n ", prop),
    ) %>%
    # Make the plot
    ggplot(aes(ymax=ymax, ymin=ymin, xmax=4, xmin=1, fill={{var}})) +
    geom_rect() +
    geom_text( x=2.5, aes(y=labelPosition, label=label),
               hjust="middle",
               size = 3.5,
               fontface = "bold",
               color = "#002060",
               family="sans") +
    scale_fill_brewer(type="seq",palette=paleta, direction=direction) +
    coord_polar(theta="y") +
    xlim(c(-1, 4)) +
    theme_void() +
    theme(legend.position = "none",
          text = element_text(size = 9, color="#002060",family="sans"),
          plot.caption = element_text(face = "italic",family="sans"),
          plot.tag = element_text(size = 8, color="grey40"),
          plot.tag.position = "topright") +
    labs(caption = "Elaborado por Pulso PUCP",
         tag = if(tag == total) {glue("N=",tag)} else {glue("N=",tag,"/",total)} )


}

# data_prueba_ruta <- system.file("data_prueba.sav", package = "pulso")
# data_prueba <- haven::read_sav(data_prueba_ruta)
# 
# data_prueba %>% 
#   grafico_donut(sexo)

# test_that("grafico_donut works", {
#   expect_error(data_prueba %>% 
#   grafico_donut(sexo), regexp = NA)
# })

Grafico pie

#' Funcion para realizar un grafico pie
#' 
#' @param data Base de datos para la funcion
#' @param var Variable para gráfico pie
#' @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 Un grafico pie
#' @examples
#' @export

grafico_pie<- function(data, var, filtrar=TRUE, color1="#A9D18E",color2="#FF9393") {

  total<-
    data %>% 
    nrow()

  tag<-
    data %>%
    filter({{filtrar}}) %>% 
    sjlabelled::as_label() %>%
    select({{var}}) %>%
    nrow()

  data<-
    data %>%
    filter({{filtrar}}) %>% 
    sjlabelled::as_label() %>%
    group_by({{var}}) %>%
    count() %>%
    rename(count=n) %>%
    ungroup()

  colores<-colorRampPalette(c(color1,color2))

  num_colores<-
    data %>%
    nrow()

  color=colores(num_colores)

  data %>% 
    mutate(prop=paste0(round_half_up(count/sum(count), digits = 2)*100, "%"),
           # Compute percentages
           fraction=count/sum(count),
           # Compute the cumulative percentages (top of each rectangle)
           ymax=cumsum(fraction),
           # Compute the bottom of each rectangle
           ymin=c(0, head(ymax, n=-1)),
           # Compute label position
           labelPosition=(ymax + ymin) / 2,
           # Compute a good label
           label=paste0({{var}}, "\n ", prop),
    ) %>%
    # Make the plot
    ggplot(aes(ymax=ymax, ymin=ymin, xmax=4, xmin=0, fill={{var}})) +
    geom_rect(colour="white", size=0.7) +
    geom_text( x=2.5, aes(y=labelPosition, label=label),
               hjust="middle",
               size = 3.5,
               fontface = "bold",
               color = "#002060",
               family="sans") +
    scale_fill_manual(values=c(color)) +
    coord_polar(theta="y", start=0) +
    xlim(c(0, 4)) +
    theme_void() +
    theme(legend.position = "none",
          text = element_text(size = 9, color="#002060",family="sans"),
          plot.caption = element_text(face = "italic",family="sans"),
          plot.tag = element_text(size = 8, color="grey40"),
          plot.tag.position = "topright") +
    labs(caption = "Elaborado por Pulso PUCP",
         tag = if(tag == total) {glue("N=",tag)} else {glue("N=",tag,"/",total)} )


}

# data_prueba_ruta <- system.file("data_prueba.sav", package = "pulso")
# data_prueba <- haven::read_sav(data_prueba_ruta)
# 
# data_prueba %>% 
#   grafico_donut(sexo)

# test_that("grafico_donut works", {
#   expect_error(data_prueba %>% 
#   grafico_donut(sexo), regexp = NA)
# })

Grafico radar

#' Funcion para realizar un grafico radar
#' 
#' @param data Base de datos para la funcion
#' @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 Un grafico radar
#' @examples
#' @export

grafico_radar<- function (data, ..., order=everything(), base.size = 20, webtype = "mini",
                          axis.labels = "", grid.min = 0, grid.max = 1, centre.y = grid.min -
                            ((1/9) * (grid.max - grid.min)), label.centre.y = FALSE,
                          grid.line.width = 0.5, grid.line.trend = "classic",
                          gridline.min.linetype = "longdash", gridline.mid.linetype = "longdash",
                          gridline.max.linetype = "longdash", gridline.min.colour = "grey",
                          gridline.mid.colour = "#007A87", gridline.max.colour = "grey",
                          grid.label.size = 3, gridline.label.offset = -0.1 * (grid.max - centre.y), label.gridline.min = TRUE, label.gridline.mid = TRUE,
                          label.gridline.max = TRUE, gridline.label = NULL, axis.label.offset = 1.15,
                          axis.label.size = 3, axis.line.colour = "grey", group.line.width = 1,
                          group.point.size = 3, group.colours = NULL, group.fill.colours = NULL,
                          background.circle.colour = "#D7D6D1", background.circle.transparency = 0.2,
                          legend.title = "", plot.legend = TRUE, plot.title = "",
                          legend.text.size = 14, radarshape = "round", polygonfill = FALSE,
                          polygonfill.transparency = 0.2, multiplots = FALSE, stripbackground = TRUE,
                          fullscore = fullscore )
{

  plot.data<-
  data %>%
  select(...) %>%
  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("enunciado","group", NA),  sep=" - ") %>%
  filter(nombres!="No") %>%
  select(-c(numero, nombres, Freq)) %>%
  group_by(group) %>%
  pivot_wider(names_from = enunciado, values_from = prop) %>%
  ungroup()

  plot.data<-
    plot.data %>% 
    select(order)

radar.tag<-
  data %>%
  select(...) %>%
  nrow()


  fullscore<-as.numeric(rep(1,ncol(plot.data)-1))

  #ggradar3
  plot.extent.x.sf = 1
  plot.extent.y.sf = 1.2
  x.centre.range = 0.02 * (grid.max - centre.y)
  if (multiplots) {
    if (length(which(colnames(plot.data) == "facet1")) ==
        0) {
      return("Error: no facet is applied.")
    }
    else {
      plot.data <- as.data.frame(plot.data)
      facet1ind <- which(colnames(plot.data) == "facet1")
      facet1df <- plot.data$facet1
      facet1df <- factor(facet1df, levels = as.vector(unique(facet1df)))
      plot.data <- plot.data[, -facet1ind]
    }
  }
  else if (multiplots == FALSE) {
    plot.data <- as.data.frame(plot.data)
  }
  else {
    return("Error: 'multiplots' can be either '1D' for facets plotting or 'none' for single plotting. ")
  }
  if (!is.null(plot.data$group)) {
    plot.data$group <- as.factor(as.character(plot.data$group))
  }
  else if (!is.null(rownames(plot.data))) {
    plot.data$group <- rownames(plot.data)
    print("Row names are chosen as the group names.")
  }
  else {
    groupcheck <- readline(" WARNING: 'group' column and row names are not detected. The first column will be chosen as the group name. Yes/no? (y/n)")
    if (groupcheck == "y") {
      plot.data[, 1] <- as.factor(as.character(plot.data[,
                                                         1]))
      names(plot.data)[1] <- "group"
    }
    else {
      print(" Abort! Data check failed! ")
      return(" Abort! Data check failed! ")
    }
  }
  col_group = which(colnames(plot.data) == "group")
  var.names <- colnames(plot.data)[-col_group]
  df_variables <- plot.data[, -col_group]
  if (!is.null(fullscore)) {
    if (length(fullscore) == ncol(df_variables)) {
      df_variables <- rbind(fullscore, df_variables)
    }
    else {
      return("Error: please provide the same length of 'fullscore' as of the variables.")
    }
  }
  df_variables <- data.frame(lapply(df_variables, function(x) scale(x,
                                                                    center = FALSE, scale = max(x, na.rm = TRUE)/grid.max)))
  if (!is.null(fullscore)) {
    df_variables <- df_variables[-1, ]
  }
  plot.data <- cbind(plot.data$group, df_variables)
  names(plot.data)[1] <- "group"
  if (length(axis.labels) == 1 && axis.labels == "") {
    axis.labels <- var.names
  }
  else {
    if (length(axis.labels) != ncol(plot.data) - 1)
      return("Error: 'axis.labels' contains the wrong number of axis labels")
  }
  plot.extent.x = (grid.max + abs(centre.y)) * plot.extent.x.sf
  plot.extent.y = (grid.max + abs(centre.y)) * plot.extent.y.sf
  if (grid.line.trend == "increase") {
    grid.line.width <- seq(from = grid.line.width, to = grid.line.width +
                             5 * 0.2, by = 0.2)
  }
  else if (grid.line.trend == "classic") {
    grid.line.width <- rep(grid.line.width, 6)
  }
  else if (grid.line.trend == "decrease") {
    grid.line.width <- rev(seq(from = grid.line.width, to = grid.line.width +
                                 5 * 0.2, by = 0.2))
  }
  else {
    return("Error: 'grid.line.trend' so far only contains two types, e.g. 'classic' and 'increase' ")
  }
  CalculateGroupPath <- function(df) {
    path <- df[, 1]
    path <- factor(path, levels = as.vector(path))
    angles = seq(from = 0, to = 2 * pi, by = (2 * pi)/(ncol(df) -
                                                         1))
    graphData = data.frame(seg = "", x = 0, y = 0)
    graphData = graphData[-1, ]
    for (i in levels(path)) {
      pathData = subset(df, df[, 1] == i)
      for (j in c(2:ncol(df))) {
        graphData = rbind(graphData, data.frame(group = i,
                                                x = pathData[, j] * sin(angles[j - 1]), y = pathData[,
                                                                                                     j] * cos(angles[j - 1])))
      }
      graphData = rbind(graphData, data.frame(group = i,
                                              x = pathData[, 2] * sin(angles[1]), y = pathData[,
                                                                                               2] * cos(angles[1])))
    }
    colnames(graphData)[1] <- colnames(df)[1]
    graphData
  }
  CaclulateAxisPath = function(var.names, min, max) {
    n.vars <- length(var.names)
    angles <- seq(from = 0, to = 2 * pi, by = (2 * pi)/n.vars)
    min.x <- min * sin(angles)
    min.y <- min * cos(angles)
    max.x <- max * sin(angles)
    max.y <- max * cos(angles)
    axisData <- NULL
    for (i in 1:n.vars) {
      a <- c(i, min.x[i], min.y[i])
      b <- c(i, max.x[i], max.y[i])
      axisData <- rbind(axisData, a, b)
    }
    colnames(axisData) <- c("axis.no", "x", "y")
    rownames(axisData) <- seq(1:nrow(axisData))
    as.data.frame(axisData)
  }
  funcCircleCoords <- function(center = c(0, 0), r = 1, npoints = 100) {
    tt <- seq(0, 2 * pi, length.out = npoints)
    xx <- center[1] + r * cos(tt)
    yy <- center[2] + r * sin(tt)
    return(data.frame(x = xx, y = yy))
  }
  plot.data.offset <- plot.data
  plot.data.offset[, 2:ncol(plot.data)] <- plot.data[, 2:ncol(plot.data)] +
    abs(centre.y)
  group <- NULL
  group$path <- CalculateGroupPath(plot.data.offset)
  axis <- NULL
  axis$path <- CaclulateAxisPath(var.names, grid.min + abs(centre.y),
                                 grid.max + abs(centre.y))
  axis$label <- data.frame(text = axis.labels, x = NA, y = NA)
  n.vars <- length(var.names)
  angles = seq(from = 0, to = 2 * pi, by = (2 * pi)/n.vars)
  axis$label$x <- sapply(1:n.vars, function(i, x) {
    ((grid.max + abs(centre.y)) * axis.label.offset) * sin(angles[i])
  })
  axis$label$y <- sapply(1:n.vars, function(i, x) {
    ((grid.max + abs(centre.y)) * axis.label.offset) * cos(angles[i])
  })
  if (webtype == "mini") {
    if (length(gridline.label) == 0) {
      values.radar <- c("0%", "50%", "100%")
    }
    else {
      if (length(gridline.label) == 3) {
        values.radar <- gridline.label
      }
      else {
        return("Error: 'gridline label' should have the same length as the mini webtype, e.g. 3. ")
      }
    }
    grid.mid <- (grid.min + grid.max)/2
    gridline <- NULL
    gridline$min$path <- funcCircleCoords(c(0, 0), grid.min +
                                            abs(centre.y), npoints = 360)
    gridline$mid$path <- funcCircleCoords(c(0, 0), grid.mid +
                                            abs(centre.y), npoints = 360)
    gridline$max$path <- funcCircleCoords(c(0, 0), grid.max +
                                            abs(centre.y), npoints = 360)
    gridline$min$label <- data.frame(x = gridline.label.offset,
                                     y = grid.min + abs(centre.y), text = as.character(grid.min))
    gridline$max$label <- data.frame(x = gridline.label.offset,
                                     y = grid.max + abs(centre.y), text = as.character(grid.max))
    gridline$mid$label <- data.frame(x = gridline.label.offset,
                                     y = grid.mid + abs(centre.y), text = as.character(grid.mid))
  }
  else if (webtype == "lux") {
    if (length(gridline.label) == 0) {
      values.radar <- c("0%", "20%", "40%",
                        "60%", "80%", "100%")
    }
    else {
      if (length(gridline.label) == 6) {
        values.radar <- gridline.label
      }
      else {
        return("Error: 'gridline label' should have the same length as the luxurious webtype, e.g. 6. ")
      }
    }
    grid.mid1 <- 0.2
    grid.mid2 <- 0.4
    grid.mid3 <- 0.6
    grid.mid4 <- 0.8
    gridline <- NULL
    gridline$min$path <- funcCircleCoords(c(0, 0), grid.min +
                                            abs(centre.y), npoints = 360)
    gridline$mid1$path <- funcCircleCoords(c(0, 0), grid.mid1 +
                                             abs(centre.y), npoints = 360)
    gridline$mid2$path <- funcCircleCoords(c(0, 0), grid.mid2 +
                                             abs(centre.y), npoints = 360)
    gridline$mid3$path <- funcCircleCoords(c(0, 0), grid.mid3 +
                                             abs(centre.y), npoints = 360)
    gridline$mid4$path <- funcCircleCoords(c(0, 0), grid.mid4 +
                                             abs(centre.y), npoints = 360)
    gridline$max$path <- funcCircleCoords(c(0, 0), grid.max +
                                            abs(centre.y), npoints = 360)
    gridline$min$label <- data.frame(x = gridline.label.offset,
                                     y = grid.min + abs(centre.y), text = as.character(grid.min))
    gridline$max$label <- data.frame(x = gridline.label.offset,
                                     y = grid.max + abs(centre.y), text = as.character(grid.max))
    gridline$mid1$label <- data.frame(x = gridline.label.offset,
                                      y = grid.mid1 + abs(centre.y), text = as.character(grid.mid1))
    gridline$mid2$label <- data.frame(x = gridline.label.offset,
                                      y = grid.mid2 + abs(centre.y), text = as.character(grid.mid2))
    gridline$mid3$label <- data.frame(x = gridline.label.offset,
                                      y = grid.mid3 + abs(centre.y), text = as.character(grid.mid3))
    gridline$mid4$label <- data.frame(x = gridline.label.offset,
                                      y = grid.mid4 + abs(centre.y), text = as.character(grid.mid4))
  }
  else {
    return("Error: 'webtype' only contains two types ('mini' and 'lux') so far.  ")
  }
  theme_clear <- theme_bw(base_size = base.size) + theme(axis.text.y = element_blank(),
                                                         axis.text.x = element_blank(), axis.ticks = element_blank(),
                                                         panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
                                                         panel.border = element_blank(), legend.key = element_rect(linetype = "blank"))
  if (multiplots) {
    facet_vec <- factor(unique(facet1df), levels = as.vector(unique(facet1df)))
    no.facet <- length(facet_vec)
    multiaxislabel <- cbind(axis$label[rep(seq_len(nrow(axis$label)),
                                           no.facet), ], rep(facet_vec, each = nrow(axis$label)))
    names(multiaxislabel)[4] <- "facet1"
    base <- ggplot2::ggplot(multiaxislabel) + xlab(NULL) +
      ylab(NULL) + coord_equal() + geom_text(data = subset(multiaxislabel,
                                                           multiaxislabel$x < (-x.centre.range)), aes(x = x,
                                                                                                      y = y, label = str_wrap(text, width = 15)), size = axis.label.size, hjust = 1, colour = "#002060") +
      scale_x_continuous(limits = c(-1.5 * plot.extent.x,
                                    1.5 * plot.extent.x)) + scale_y_continuous(limits = c(-plot.extent.y,
                                                                                          plot.extent.y)) + facet_wrap(~facet1)
  }
  else if (multiplots == FALSE) {
    base <- ggplot2::ggplot(axis$label) + xlab(NULL) + ylab(NULL) +
      coord_equal() + geom_text(data = subset(axis$label,
                                              axis$label$x < (-x.centre.range)), aes(x = x, y = y,
                                                                                     label = str_wrap(text, width = 15)), size = axis.label.size, hjust = 1, colour = "#002060") +
      scale_x_continuous(limits = c(-1.5 * plot.extent.x,
                                    1.5 * plot.extent.x)) + scale_y_continuous(limits = c(-plot.extent.y,
                                                                                          plot.extent.y))
  }
  else {
    return("Error: 'multiplots' can be either '1D' for facets plotting or 'none' for single plotting. ")
  }
  if (radarshape == "round") {
    if (webtype == "mini") {
      base <- base + geom_path(data = gridline$min$path,
                               aes(x = x, y = y), lty = gridline.min.linetype,
                               colour = gridline.min.colour, size = grid.line.width[1])
      base <- base + geom_path(data = gridline$mid$path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[2])
      base <- base + geom_path(data = gridline$max$path,
                               aes(x = x, y = y), lty = gridline.max.linetype,
                               colour = gridline.max.colour, size = grid.line.width[3])
    }
    else if (webtype == "lux") {
      base <- base + geom_path(data = gridline$min$path,
                               aes(x = x, y = y), lty = gridline.min.linetype,
                               colour = gridline.min.colour, size = grid.line.width[1])
      base <- base + geom_path(data = gridline$mid1$path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[2])
      base <- base + geom_path(data = gridline$mid2$path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[3])
      base <- base + geom_path(data = gridline$mid3$path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[4])
      base <- base + geom_path(data = gridline$mid4$path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[5])
      base <- base + geom_path(data = gridline$max$path,
                               aes(x = x, y = y), lty = gridline.max.linetype,
                               colour = gridline.max.colour, size = grid.line.width[6])
    }
    else {
      return("Error: 'webtype' only contains two types ('mini' and 'lux') so far.  ")
    }
  }
  else if (radarshape == "sharp") {
    if (webtype == "mini") {
      oddindex <- seq(1, nrow(axis$path), 2)
      evenindex <- seq(2, nrow(axis$path), 2)
      axis$innerpath <- axis$path[oddindex, ]
      axis$outerpath <- axis$path[evenindex, ]
      axis$innerpath <- rbind(axis$innerpath, head(axis$innerpath,
                                                   1))
      axis$outerpath <- rbind(axis$outerpath, head(axis$outerpath,
                                                   1))
      axis$middlepath <- (axis$innerpath + axis$outerpath)/2
      base <- base + geom_path(data = axis$innerpath, aes(x = x,
                                                          y = y), lty = gridline.min.linetype, colour = gridline.min.colour,
                               size = grid.line.width[1]) + geom_path(data = axis$outerpath,
                                                                      aes(x = x, y = y), lty = gridline.max.linetype,
                                                                      colour = gridline.max.colour, size = grid.line.width[3]) +
        geom_path(data = axis$middlepath, aes(x = x,
                                              y = y), lty = gridline.mid.linetype, colour = gridline.mid.colour,
                  size = grid.line.width[2])
    }
    else if (webtype == "lux") {
      oddindex <- seq(1, nrow(axis$path), 2)
      evenindex <- seq(2, nrow(axis$path), 2)
      axis$innerpath <- axis$path[oddindex, ]
      axis$outerpath <- axis$path[evenindex, ]
      axis$innerpath <- rbind(axis$innerpath, head(axis$innerpath,
                                                   1))
      axis$outerpath <- rbind(axis$outerpath, head(axis$outerpath,
                                                   1))
      axis$middle1path <- (-axis$innerpath + axis$outerpath)/5 +
        axis$innerpath
      axis$middle2path <- (-axis$innerpath + axis$outerpath) *
        2/5 + axis$innerpath
      axis$middle3path <- (-axis$innerpath + axis$outerpath) *
        3/5 + axis$innerpath
      axis$middle4path <- (-axis$innerpath + axis$outerpath) *
        4/5 + axis$innerpath
      base <- base + geom_path(data = axis$innerpath, aes(x = x,
                                                          y = y), lty = gridline.min.linetype, colour = gridline.min.colour,
                               size = grid.line.width[1])
      base <- base + geom_path(data = axis$middle1path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[2])
      base <- base + geom_path(data = axis$middle2path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[3])
      base <- base + geom_path(data = axis$middle3path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[4])
      base <- base + geom_path(data = axis$middle4path,
                               aes(x = x, y = y), lty = gridline.mid.linetype,
                               colour = gridline.mid.colour, size = grid.line.width[5])
      base <- base + geom_path(data = axis$outerpath, aes(x = x,
                                                          y = y), lty = gridline.max.linetype, colour = gridline.max.colour,
                               size = grid.line.width[6])
    }
    else {
      return("Error: 'webtype' only contains two types ('mini' and 'lux') so far.  ")
    }
  }
  else {
    return("Error: 'radarshape' should be specified...")
  }
  base <- base + geom_text(data = subset(axis$label, abs(axis$label$x) <=
                                           x.centre.range), aes(x = x, y = y, label = str_wrap(text, width = 15)), size = axis.label.size,
                           hjust = 0.5, colour = "#002060")
  base <- base + geom_text(data = subset(axis$label, axis$label$x >
                                           x.centre.range), aes(x = x, y = y, label = str_wrap(text, width = 15)), size = axis.label.size,
                           hjust = 0, colour = "#002060")
  base <- base + theme_clear
  if (radarshape == "round") {
    base <- base + geom_polygon(data = gridline$max$path,
                                aes(x = x, y = y), fill = background.circle.colour,
                                alpha = background.circle.transparency)
  }
  else if (radarshape == "sharp") {
    base <- base + geom_polygon(data = axis$outerpath, aes(x = x,
                                                           y = y), fill = background.circle.colour, alpha = background.circle.transparency)
  }
  else {
    return("Error: 'radarshape' should be specified...")
  }
  base <- base + geom_path(data = axis$path, aes(x = x, y = y,
                                                 group = axis.no), colour = axis.line.colour)
  if (multiplots) {
    multigrouppath <- cbind(group$path, rep(facet1df, each = nrow(group$path)/nrow(plot.data)))
    names(multigrouppath)[4] <- "facet1"
    if (polygonfill) {
      base <- base + geom_polygon(data = multigrouppath,
                                  aes(x = x, y = y, col = factor(group), fill = factor(group)),
                                  alpha = polygonfill.transparency, show.legend = F) +
        facet_wrap(~facet1)
    }
    base <- base + geom_path(data = multigrouppath, aes(x = x,
                                                        y = y, group = group, colour = group), size = group.line.width) +
      facet_wrap(~facet1)
    base <- base + geom_point(data = multigrouppath, aes(x = x,
                                                         y = y, group = group, colour = group), size = group.point.size) +
      facet_wrap(~facet1)
  }
  else if (multiplots == FALSE) {
    if (polygonfill) {
      base <- base + geom_polygon(data = group$path, aes(x = x,
                                                         y = y, col = factor(group), fill = factor(group)),
                                  alpha = polygonfill.transparency, show.legend = F)
    }
    base <- base + geom_path(data = group$path, aes(x = x,
                                                    y = y, group = group, colour = group), size = group.line.width)
    base <- base + geom_point(data = group$path, aes(x = x,
                                                     y = y, group = group, colour = group), size = group.point.size)
  }
  else {
    return("Error: 'multiplots' can be either '1D' for facets plotting or 'none' for single plotting. ")
  }
  if (plot.legend) {
    if (multiplots == FALSE) {
      base <- base + labs(colour = legend.title, size = legend.text.size) +
        theme(legend.text = element_text(size = legend.text.size),
              legend.position = "left") + theme(legend.key.height = unit(2,
                                                                         "line"))
    }
    else if (multiplots) {
      base <- base + labs(colour = legend.title, size = legend.text.size) +
        theme(legend.text = element_text(size = legend.text.size),
              legend.position = "bottom") + theme(legend.key.height = unit(2,
                                                                           "line"))
    }
    else {
      return("Error: 'multiplots' can be either '1D' for facets plotting or 'none' for single plotting. ")
    }
  }
  else {
    base <- base + theme(legend.position = "none")
  }
  if (label.gridline.min == TRUE) {
    base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[1], width = 15)),
                             data = gridline$min$label, size = grid.label.size *
                               0.8, hjust = 1, colour = "#002060")
  }
  if (label.gridline.max == TRUE) {
    base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[length(values.radar)], width = 15)),
                             data = gridline$max$label, size = grid.label.size *
                               0.8, hjust = 1, colour = "#002060")
  }
  if (webtype == "mini") {
    if (label.gridline.mid == TRUE) {
      base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[2], width = 15)),
                               data = gridline$mid$label, size = grid.label.size *
                                 0.8, hjust = 1, colour = "#002060")
    }
  }
  else if (webtype == "lux") {
    if (label.gridline.mid == TRUE) {
      base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[2], width = 15)),
                               data = gridline$mid1$label, size = grid.label.size *
                                 0.8, hjust = 1, colour = "#002060")
      base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[3], width = 15)),
                               data = gridline$mid2$label, size = grid.label.size *
                                 0.8, hjust = 1, colour = "#002060")
      base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[4], width = 15)),
                               data = gridline$mid3$label, size = grid.label.size *
                                 0.8, hjust = 1, colour = "#002060")
      base <- base + geom_text(aes(x = x, y = y, label = str_wrap(values.radar[5], width = 15)),
                               data = gridline$mid4$label, size = grid.label.size *
                                 0.8, hjust = 1, colour = "#002060")
    }
  }
  else {
    return("Error: 'webtype' only contains two types ('mini' and 'lux') so far.  ")
  }
  if (label.centre.y == TRUE) {
    centre.y.label <- data.frame(x = 0, y = 0, text = as.character(centre.y))
    base <- base + geom_text(aes(x = x, y = y, label = str_wrap(text, width = 15)),
                             data = centre.y.label, size = grid.label.size, hjust = 0.5, colour = "#002060")
  }
  if (!is.null(group.colours)) {
    colour_values <- rep(group.colours, 100)
    if (!is.null(group.fill.colours)) {
      fill_values <- rep(group.fill.colours, 100)
    }
    else {
      fill_values <- colour_values
    }
  }
  else {
    colour_values <- rep(c("#FF5A5F", "#FFB400",
                           "#007A87", "#8CE071", "#7B0051",
                           "#00D1C1", "#FFAA91", "#B4A76C",
                           "#9CA299", "#565A5C", "#00A04B",
                           "#E54C20"), 100)
    fill_values <- colour_values
  }
  base <- base + theme(legend.key.width = unit(3, "line")) +
    theme(text = element_text(size = 20)) + scale_colour_manual(values = colour_values) +
    scale_fill_manual(values = fill_values) + theme(legend.title = element_blank())
  if (plot.title != "") {
    base <- base + ggtitle(plot.title)
  }
  if (stripbackground == FALSE) {
    base <- base + theme(strip.background = element_blank())
  }

  base +

  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 = "topright",

        text = element_text(size = 9, color="#002060",family="sans"),
        ) +
  guides(color=guide_legend(nrow = 2, byrow = TRUE)) +
  coord_equal(clip="off")
}

# 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")

# test_that("grafico_donut works", {
#   expect_error(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 = "topright",
#         
#         text = element_text(size = 9, color="#002060",family="sans"),
#         ) +
#   guides(color=guide_legend(nrow = 2, byrow = TRUE)) +
#   coord_equal(clip="off"), regexp = NA)
# })

Tablas de cruces

#' 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
#' @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.")}

}
#

# 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")

# test_that("grafico_donut works", {
#   expect_error(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 = "topright",
#         
#         text = element_text(size = 9, color="#002060",family="sans"),
#         ) +
#   guides(color=guide_legend(nrow = 2, byrow = TRUE)) +
#   coord_equal(clip="off"), regexp = NA)
# })

Salto

#' Funcion para insertar un salto de pagina luego de cada tabla. Necesario para que las tablas no se peguen.
#' 
#' @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 Un grafico radar
#' @examples
#' @export

salto<-function(){
  officer::run_linebreak()
}

# 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")

# test_that("grafico_donut works", {
#   expect_error(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 = "topright",
#         
#         text = element_text(size = 9, color="#002060",family="sans"),
#         ) +
#   guides(color=guide_legend(nrow = 2, byrow = TRUE)) +
#   coord_equal(clip="off"), regexp = NA)
# })

# Run but keep eval=FALSE to avoid infinite loop
# Execute in the console directly
fusen::inflate(flat_file = "dev/flat_minimal.Rmd", vignette_name = "Introduccion")

aito123/pulso documentation built on June 21, 2022, 4:32 p.m.