R/grafico_aceptacion.R

In anmarsan/sandres: sandres

#'Grafico para representar la aceptación.
#'
#'Es apropiado para mediciones en escalas que empiecen por 1.
#'
#'@param datos Debe ser un data frame con 4 columnas, correspondientes a la identificación de los individuos, las muestras, los atributos y los valores.
#'@param muestras Nombre de la columna en que se almacenan los identificadores de las muestras. Por defecto es "Muestra".
#'@param atributos Nombre de la columna en que se almacenan los identificadores de los atributos Por defecto es "Atributo".
#'@param valores Nombre de la columna en que se almacenan los identificadores de los valores Por defecto es "Valor".
#'@param individuos Nombre de la columna en que se almacenan los identificadores de los individuos Por defecto es "Id".
#'@param inicio_escala Valor de inicio de la escala numérica. Por defecto es 1.
#'@param fin_escala Valor de fin de la escala numérica. Por defecto es 9.
#'@param etiqueta_dato Boolean. Decide si se utilizan etiquetas de los valores. Por defecto TRUE.
#'@param etiqueta_p_valor Boolean. Decide si se utilizan etiquetas de los p valores. Por defecto TRUE.
#'@param etiqueta_tukey Boolean. Decide si se utilizan etiquetas para las agrupaciones de tukey. Por defecto TRUE.
#'@param colores Named vector. Decide los colores de las columnas en función a las muestras. Por defecto NULL y se escogen los colores por defecto de ggplot. Debe ser un vector con un valor por cada muestra.
#'@param titulo Título del gráfico, por defecto NULL
#'@param tamaño_etiquetas Tamaño de las etiquetas de texto. Por defecto 3.
#'@param posicion_p_valor Posición en el eje x del p valor. Por defecto 8.
#'@return El resultado es un gráfico de barras agrupado
#'@export




grafico_aceptacion <- function(
    datos = datos_aceptacion,
    muestras = "Muestra",
    atributos = "Atributo",
    valores = "Valor",
    individuos = "Id",
    inicio_escala = 1,
    fin_escala = 9,
    etiqueta_dato = TRUE,
    etiqueta_p_valor = TRUE,
    etiqueta_tukey = TRUE,
    colores = NULL,
    titulo = NULL,
    tamaño_etiquetas = 3,
    posicion_p_valor = 8
){

  library(tidyverse)
  library(agricolae)

  #Caculo del numero de muestras presentes

  corrector <- ifelse(inicio_escala == 0,0,1)

  n_muestras <- n_distinct(datos[muestras])

  #Se renombran las columnas

  datos <- datos %>%
    rename("muestras" = muestras,
           "atributos" = atributos,
           "valores" = valores,
           "individuos" = individuos) %>%
    mutate(valores = as.numeric(as.character(valores)))

  #calculo de p valor con t de student o anova en funcion de n_muestras

  if(n_muestras == 2) {
    p_valor <- datos %>%
      group_by(atributos) %>%
      nest() %>%
      mutate(data = map(
        data,
        ~ t.test(
          valores ~ muestras,
          alternative = "two.sided",
          conf.level = .95,
          paired = T,
          vari.equal = FALSE,
          data = .x
        )$p.value
      )) %>%
      rename("p_valor" = data) %>%
      mutate(etiqueta = as.character(round(as.numeric(p_valor), 2)),
             etiqueta = recode(etiqueta,
                               "0" = "<0.001"))
  } else if (n_muestras > 2) {
    p_valor <- datos %>%
      group_by(atributos) %>%
      nest() %>%
      mutate(aov = map(data, ~
                         aov(valores ~ muestras + individuos,
                             data = .x))) %>%
      mutate(p_valor = map(aov, ~ summary(.x)[[1]][["Pr(>F)"]][[1]])) %>%
      select(atributos,p_valor) %>%
      mutate(etiqueta = as.character(round(as.numeric(p_valor), 2)),
             etiqueta = recode(etiqueta,
                               "0" = "<0.001"))
  }

  # Tukey

  if (n_muestras > 2) {
    tukey <- datos %>%
      group_by(atributos) %>%
      nest() %>%
      mutate(aov = map(data, ~
                         aov(valores ~ muestras + individuos,
                             data = .x))) %>%
      mutate(
        tukey = map(
          aov,
          ~ HSD.test(.x, "muestras", group = TRUE)$groups %>%
            rownames_to_column(var = "Muestra") %>%
            select(-valores) %>%
            pivot_wider(names_from = Muestra,
                        values_from = groups)
        )
      ) %>%
      unnest(tukey) %>%
      select(-data,-aov) %>%
      pivot_longer(cols = !any_of("atributos"),
                   names_to = "muestras",
                   values_to = "grupos"
      )

  } else {
    tukey = NULL
  }

  #Calculo de las medias segun muestra y atributo

  media <- datos %>%
    group_by(muestras,atributos) %>%
    summarise(valores = mean(valores),
              .groups = "keep") %>%
    mutate(valores = valores - corrector) %>%
    ungroup() %>%
    arrange(desc(valores)) %>% #Se ordenan en funcion del valor
    mutate(muestras = factor(muestras, levels = unique(muestras)))

  if(!is.null(tukey)){
    media <- media %>%
      full_join(tukey,by = c("muestras","atributos"))
  }

  #construccion de grafico basico

  grafico <- ggplot(
    data = media,
    aes(x = valores, y = atributos, fill = muestras)) +
    geom_bar(
      width = 0.5,
      position = "dodge",
      stat = "identity"
    ) +
    labs(y = NULL,
         x = NULL,
         fill = NULL,
         title = titulo) +
    scale_x_continuous(
      limits = c(inicio_escala - corrector, fin_escala - corrector),
      breaks =  seq(
        from = inicio_escala - corrector,
        to = fin_escala - corrector,
        by = 1
      ),
      labels = seq(from = inicio_escala, to = fin_escala, by = 1)
    )+
    guides(fill = guide_legend(reverse = TRUE)) +
    theme_minimal() +
    theme(legend.position = "bottom")



  #Se añade etiqueta de dato

  if (etiqueta_dato) {
    grafico <- grafico +
      geom_text(
        position = position_dodge2(width = 0.5, padding = 0.1),
        aes(
          y = atributos,
          x = valores + 0.30,
          label = round(valores + corrector, 1)
        ),
        hjust = 0,
        vjust = 0.25,
        angle = 0,
        size = tamaño_etiquetas
      )
  }

  #Se añade etiqueta tukey

  if(!is.null(tukey) & etiqueta_tukey){
    grafico <- grafico +
      geom_text(
        position = position_dodge2(width = 0.5, padding = 0.1),
        aes(
          y = atributos,
          x = valores + 0.80,
          label = grupos
        ),
        hjust = 0,
        vjust = 0.25,
        angle = 0,
        size = tamaño_etiquetas
      )
  }

  #Se añade etiqueta de p_valor por variable

  if (etiqueta_p_valor) {
    grafico <- grafico +
      annotate(
        "text",
        x = posicion_p_valor,
        y = p_valor$atributos,
        label = ifelse(p_valor$p_valor > 0.05, "", p_valor$etiqueta),
        size = tamaño_etiquetas
      )
  }

  #Se asignan colores si son suministrados

  if(!is.null(colores)){
    grafico <- grafico +
      scale_fill_manual(values = colores)
  }

  return(grafico)

}