R/mean_drop.R

In anmarsan/sandres: sandres

#'Grafico mean_drop
#'
#'Crea un gráfico tipo mean drop. Es útil cuando hay valoraciones numéricas y preguntas jar.
#'
#'
#'
#'@param datos Debe ser un data frame con 4 columnas, correspondientes a las muestras, la variable like, las variables jar y los niveles de las variables jar.
#'@param variables_jar Nombre de la columna en que se almacenan los nombres de las variables jar.
#'@param variable_like Nombre de la columna en que se almacena la variable like.
#'@param nivel Nombre de la columna en que se almacenan los niveles jar.
#'@param muestras Nombre de la columna donde se almacenan las muestras.
#'@param nombre_niveles named vector con los valores de los niveles correspondientes a los tres niveles.
#'@param etiqueta_jar_izquierda Etiqueta para el gráfico de la posición izquierda de jar.
#'@param etiqueta_jar_derecha Etiqueta para el gráfico de la posición derecha de jar.
#'@param color_jar_izquierda Color para el gráfico de la posición derecha de jar.
#'@param color_jar_derecha Color para el gráfico de la posición derecha de jar.
#'@return El resultado es un gráfico mean drop
#'@export

mean_drop <- function(datos,
                      variables_jar = "variables_jar" ,
                      variable_like = "Valoración global",
                      nivel = "Nivel",
                      muestras = "Muestra",
                      nombre_niveles = c(
                        "Menos de lo que me gusta" = "jar_izquierda",
                        "Justo como me gusta" = "jar_centro",
                        "Más de lo que me gusta" = "jar_derecha"
                      ),
                      etiqueta_jar_izquierda = "Menos de lo que me gusta",
                      etiqueta_jar_derecha = "Más de lo que me gusta",
                      color_jar_izquierda = "red",
                      color_jar_derecha = "blue") {

  library(ggrepel)
  library(tidyverse)

  colores <-  c(jar_izquierda = color_jar_izquierda,
                jar_derecha = color_jar_derecha)

  datos <- datos %>%
    rename(
      "muestras" = muestras,
      "Nivel" = nivel,
      "variable_like" = variable_like
    ) %>%
    mutate(Nivel = recode(Nivel, !!!nombre_niveles))

  entrada <- datos %>%
    group_by(muestras, Variable_jar, Nivel) %>%
    summarise(
      absoluto = n(),
      media = mean(variable_like),
      .groups = "keep"
    ) %>%
    group_by(muestras, Variable_jar) %>%
    mutate(frecuencia = absoluto / sum(absoluto)) %>%
    select(-absoluto)

  drop <- entrada %>%
    select(-frecuencia) %>%
    pivot_wider(names_from = Nivel,
                values_from = media) %>%
    mutate(jar_derecha =
             jar_centro - jar_derecha,
           jar_izquierda =
             jar_centro - jar_izquierda) %>%
    pivot_longer(
      cols = c(jar_derecha,
               jar_centro,
               jar_izquierda),
      names_to = "Nivel",
      values_to = "drop"
    )

  grafico <- full_join(entrada, drop) %>%
    filter(Nivel != "jar_centro")  %>%
    ggplot() +
    geom_point(aes(x = frecuencia, y = drop)) +
    geom_text_repel(
      aes(
        x = frecuencia,
        y = drop,
        label = Variable_jar,
        color = Nivel
      ),
      nudge_x = 0.035,
      nudge_y = 0.035,
      min.segment.length = 0.1
    ) +
    scale_color_manual(
      values = colores,
      labels = c(jar_izquierda = etiqueta_jar_izquierda,
                 jar_derecha = etiqueta_jar_derecha)
    ) +
    theme_light() +
    facet_wrap( ~ muestras,
                ncol = 1)

  return(grafico)

}