2

Pregunta Actualizada

Muy buenas, hace ya tiempo que vengo usando un código para hacer boxplots según un factor, lo que me ayuda un montón a la hora de ver cómo varian las distintas variables univariantemente.

Me gustaria ampliarlo para poder mostrar como labels en los outlier, el valor respectivo de una columna (no necesariamente la que se muestra); como sería por ejemplo una columna que sirva de ID o el rowname. Llevo peleándome con esto unos días, pero no encuentro manera ni forma de adaptarlo.

Gracias a la labor de Patricio Moracho, que con su código ha conseguido mostrar la etiqueta de los outliers.

Usando iris como ejemplo, que tiene cuatro columnas, añadimos una columna más que nos sirva como id.

iris2 = iris
iris2$id = c(1:nrow(iris2))

Y me gustaria modificar la función para que en lugar del valor del outlier, como es el código actual -gracias de nuevo a las respuestas de este post- muestre el valor del id respectivo a dicho outlier.

customPlot3 <- function(varName, df, paleta=mi_paleta, Var_by) {
  
  is_outlier <- function(x) {
    x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x)
  }
  
  
  df %>% 
      ggplot(aes_string(y=varName, x = Var_by, fill = Var_by)) + 
      geom_boxplot(outlier.size=4, outlier.color="red", outlier.fill="red") +
      scale_fill_manual(values = paleta) +
      stat_summary(fun=mean, 
                   geom="point", 
                   position=position_dodge(.9), 
                   color="black", size=4) +
      stat_summary(
        aes(label = round(stat(y), 2)),
        geom = "text", 
        fun = function(y) { 
                  o <- y[is_outlier(y)]
                  if(length(o) == 0) NA else {o}
                },
          hjust = -.8
      )
}

Porque actualmente queda así.

customPlot3("Sepal.Width", iris, paleta = mi_paleta, "Species")

introducir la descripción de la imagen aquí

He intentado una aproximación simplemente extrayendo los valores como un vector, pero me da mal la respuesta ya que teóricamente deberian coincidir 2 setosa y2 virginica.

customPlot4 <- function(varName, df, paleta=mi_paleta, Var_by,var_id) {
  
   mi_paleta =  c("white", "red", "pink", "blue", "lightblue", "green", "lightgreen","brown4" ,"brown3")
 # Var_by = "Etiología"
 
  
  is_outlier <- function(x) {
    x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x)
  }
  
  etiqueter <- function(y) { 
                  o <- y[is_outlier(y)]
                  if(length(o) == 0) NA else {o}
                }
# 
#    mis_outlier = unname(unlist(is_outlier(df[varName])))
#    mis_etiquetas = unname(unlist(df[mis_outlier,var_id]))
   
   solution = df[is_outlier(unname(unlist(df[varName]))),var_id] 
   
   
   # mis_etiquetas2 = etiqueter(varName)
   
   # print(mis_etiquetas)
   print(solution)
   
   # print("Y ahora")
   # print(mis_etiquetas2)
   
 
}
 customPlot4(varName = "Sepal.Width",df=iris,Var_by =  "Species",var_id="Species")

1 setosa setosa setosa versicolor Levels: setosa versicolor virginica

Nota

Acabo de descubrir porque eso sería sin tener en cuenta cada "especie" es decir el factor. Si hago la funcion para ver outliers las tres cajas por separadas, sí que permite.

Sigo sin poder hacer que me coja los valores de otra columna que no sean las ploteadas en el gráfico para los outliers (mostrando los correspondientes valores).

Pregunta Original

library(ggplot2)
 customPlot2 <- function(varName, df, paleta=mi_paleta, Var_by) {
   

 mi_paleta =  c("white", "red", "pink", "blue", "lightblue", "green", "lightgreen","brown4" ,"brown3")
 # Var_by = "Etiología"


 ggplot(df, aes_string(Var_by,varName,fill=Var_by), )+scale_fill_manual(values = mi_paleta)+ geom_boxplot(outlier.size=2,outlier.colour="red" )+ stat_summary(fun=mean, geom="point", aes(group=Var_by), position=position_dodge(.9),
                color="black", size=4)

 }

Lo que me permite hacer luego un lapply para las variables que quiera (muchas veces no me interesa ver todas).

(varlist <- colnames(iris))
lapply(varlist, customPlot2, df=iris, Var_by="Species")

¿Alguna forma de cómo podría hacer esto? He hecho un intento a partir de un post de stack que usaba dplyr, pero no he conseguido que funcione:

library(dplyr)

 customPlot3 <- function(varName, df, paleta=mi_paleta, Var_by,var_label) {
is_outlier <- function(x) {
  return(x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x))
}
   
df %>% 
  group_by(Var_by) %>%
  mutate(outlier=ifelse(is_outlier(varName),var_label,as.numeric(NA))) %>%
  ggplot(aes(x=factor(Var_by), varName)) + 
    geom_boxplot(outlier.colour = NA) +
    ggbeeswarm::geom_beeswarm(aes(color=varName)) +
    ggrepel::geom_text_repel(data=. %>% filter(!is.na(outlier)), aes(label=var_label)) +
    scale_colour_gradient(low="blue",high="red")
   
 }

3 respuestas 3

1

Respuesta actualizada

Se podrían usar tres funciones encadenadas:

  1. etiquetar() que crea las etiquetas
  2. graficar() que crea las etiquetas de outliers llamando a la función anterior y después hace el gráfico para cada variable. De paso pone el nombre de variable como título.
  3. imap para pasar esa función a todos los elementos del un data.frame y usa los nombres (un segundo argumento implícito) para el titulado de los gráfico.

Va un ejemplo con mtcars

etiquetar_outliers <- function(x, id) {
  ifelse(x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x), id, NA)
}

graficar <- function(x, id, nombre = "nombre") {
  df = data.frame(valor = x, 
                  variable = nombre,
                  etiquetas = etiquetar_outliers(x, id))
  ggplot(df, aes(y = valor ,x =variable , label = etiquetas)) +
    geom_boxplot() + 
    geom_label_repel(na.rm = TRUE) + 
    labs(title = nombre)
}

id <- rownames(mtcars)  #Supongo que el ID de fila es siempre el mismo. Lo extraigo como vector al entorno global así lo puedo usar en la llamada a la siguiente función.  

imap(mtcars, ~graficar(.x, id, .y))

Está medio enredada y le falta documentación. Pero anda (So does a burning bus).

Respuesta original

Sigo pensando que para la mayoría de los casos es mejor opción, excepto que sean muchas columnas y/o muchos outliers.

Va una alternativa. Creo que es una solución a tu problema, aunque el enfoque es muy diferente al que estabas usando. En lugar de crear una función que grafique cada columna en el data.frame uso formato largo (pares de variable/valor) y luego facet_wrap() para graficar todas las columnas en un mismo plot. Quizás no te sirva porque necesitas cada gráfico por separado en una lista. Quizás te sirva.

Primero defino una función que identifica outliers. La tomo de tu código.

is_outlier <- function(x) {
  x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x)
}

Como no incluyes un ejemplo de tus datos uso los datos mtcars. Quizás los tuyos sean diferentes y esta solución no sirva. Ayudaría que incluyeras un ejemplo de los datos. Selecciona a mano las columnas, se podría usar una predicativa como is.numeric. Hago una columna explícita con los rownames, si no dplyr se complica.

mtcars %>% 
  select(mpg, disp, hp, wt, qsec) %>% 
  rownames_to_column("auto") -> mtcars2 

Ahora creo un data.frame con las etiquetas. Cuando es outlier tengo la etiqueta (el nombre del auto en este caso, puede ser un ID, etc.), cuando no lo es tengo NA. ggplot2 no imprimirá los NA, de este modo solo tendré etiquetados a los outliers. Lo paso a formato largo con pivot_longer(), creando pares de clave valor. Conservo la variable auto, me servirá luego para reunirla con el resto de los datos. Podría ser cualquier identificador único de fila que tengas en tus datos (ID sería re candidato).

mutate_if(mtcars2, is.numeric, ~ifelse(is_outlier(.), auto, NA)) %>% 
  pivot_longer(cols = -auto, 
               names_to = "variable", 
               values_to = "etiqueta") -> etiquetas

Ahora paso a formato largo a los datos numéricos que voy a usar para los boxplots. Así puedo luego aprovechar facet_wrap() y hacer un panel para cada variable en mi gráfico.

También reúno a los datos con las etiquetas. Como tengo en común la variable auto y esta es un identificador único un left_join() es muy seguro. No va a desordenar los datos.

mtcars2 %>% 
  pivot_longer(cols = -auto, 
               names_to = "variable", 
               values_to = "valor") %>% 
  left_join(etiquetas) -> mtcars2_completo

Es bastante simple el gráfico:

  ggplot(aes(x = variable, #Una caja por cada variable
             y = valor,    #Los datos con los que obtiene el boxplot 
             label = etiqueta) #Este argumento es para geom_label_repel, la clave son los NA para que no imprima etiquetas de no outliers
         ) + 
    geom_boxplot() + 
    geom_label_repel(na.rm = TRUE) +       
    facet_wrap(~variable, scales = "free")  # El scales="free" para que cada variable esté en su propia escala.

Obtengo:

introducir la descripción de la imagen aquí

¿Se parece a lo que buscas? Si no coméntalo, por favor.

Entiendo que buscas una función que reciba nombres como argumentos. Sin problema, es aceptable. Sin embargo comento algunos inconvenientes para esa solución.

  1. Las interfaces de programación en dplyr y ggplot son intrínsecamente complicadas y cambiantes. Complicadas pq el chiste de dplyr es que aceptan argumentos que no son estrictamente nombres sin usar las comillas. Para eso usa evaluación no estándar y ahí dentro todo es confuso, no se sabe cuando usar directamente el nombre, cuando evaluar el nombre y usar el output de esa evaluación. Cambiantes porque ya van por la tercera interfaz para resolver este problema, primero las funciones con el sufijo _ para evaluación estándar, pero ya están deprecated y en algún momento las van a quitar. Después el infame !! y las quasiquotations que nunca nadie entendió y últimamente {{}}. Wickham, el desarrollador a cargo, tiene una aproximación muy elástica a la estabilidad de las APIs, así que quizás cambie mañana. Trato a cualquier solución de programación con nombres dentro de dplyr/tidyverse` como momentánea y sujeta a cambios.

  2. Trato de aplicar siempre que puedo la regla de la representación de la filosofía UNIX. "Fold knowledge into data so program logic can be stupid and robust". Se me hace más fácil crear estructuras de datos complicadas (que puedo verificar paso a paso si tengo un error y corregirlo) que funciones complicadas dentro de las cuales que pescar un error muy difícil. Esto es opinión personal.

11
  • De primeras tengo un fallo que es "Error: data must be a data frame, or other object coercible by fortify(), not an S3 object with class uneval Did you accidentally pass aes() to the data argument? Run rlang::last_error() to see where the error occurred." Resultante de copiar tu código. Intentaré resolverlo... Por otro lado esta aproximación me valdría (a ver si consigo resolver este último error), pero me gustaría tenerlas como en mi otra aproximación por lapply porque tengo como 80 variables y me va a hacer un único gráfico que no voy a poder ver. Voy a intentar trducirla
    – Galpaccru
    Commented el 26 ene. 2021 a las 17:06
  • Además, en algunos casos tengo muchas observaciones, así que ampliar el dataset como el completo tampoco es que me venga muy bien que digamos. Pero voy a ver cómo puedo resolverlo para que me calcule los outlier para cada variable y me haga etiquetas.
    – Galpaccru
    Commented el 26 ene. 2021 a las 17:08
  • El código que compartí funciona con un data.frame como input, quizás de ahí venga el error que recibes. Si puedes poner un ejemplo de tus datos (es decir, si no son confidenciales) sería más fácil encontrar una solución específica al problema. Entiendo que por la cantidad de variables y filas se complica esta aproximación. Quizás puedas adaptar parte del código para crear las cajas por separado. Suerte!
    – mpaladino
    Commented el 26 ene. 2021 a las 17:25
  • No, si el error me ha pasado con mtcars :C. De todas formas me ha ayudado mucho, voy a ponerla por buena aunque si encuentro forma de hacerlo con el sapply lo pongo despues como segunda respuesta :D.
    – Galpaccru
    Commented el 26 ene. 2021 a las 17:54
  • Ahhh... eso sí está raro. Voy a revisar si no metí dedazo al copiar el código. En mi sesión de R funciona con mtcars. Vale, ojalá encuentres una solución más acorde a tu problema y que bueno que te haya ayudado.
    – mpaladino
    Commented el 26 ene. 2021 a las 18:07
1

Comparto totalmente la filosofía detrás de la respuesta de @mpaladino, si pudieras reproducir su respuesta, sería lo ideal. Sin embargo, si quieres conservar tu aproximación al problema, hay algunas buenas respuestas aqui, la que me ha parecido muy práctica en este caso, es aquella que hace uso de un stat_summary para ubicar un geom_text para cada "outlier":

stat_summary(
  aes(label = round(stat(y), 2)),
  geom = "text", 
  fun = function(y) { 
    o <- y[is_outlier(y)]
    if(length(o) == 0) NA else {o}
  },
  hjust = -.8
)

Finalmente, podrías adaptar tu función:

customPlot3 <- function(varName, df, paleta=mi_paleta, Var_by) {
  
  is_outlier <- function(x) {
    x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x)
  }
  
  
  df %>% 
      ggplot(aes_string(y=varName, x = Var_by, fill = Var_by)) + 
      geom_boxplot(outlier.size=4, outlier.color="red", outlier.fill="red") +
      scale_fill_manual(values = paleta) +
      stat_summary(fun=mean, 
                   geom="point", 
                   position=position_dodge(.9), 
                   color="black", size=4) +
      stat_summary(
        aes(label = round(stat(y), 2)),
        geom = "text", 
        fun = function(y) { 
                  o <- y[is_outlier(y)]
                  if(length(o) == 0) NA else {o}
                },
          hjust = -.8
      )
}

El funcionamiento sería similar al actual:

customPlot3("Sepal.Width", iris, paleta = mi_paleta, "Species")

introducir la descripción de la imagen aquí

6
  • Esta me parece perfecta (la estaba haciendo mas o menos asi con un bucle, pero su solución es mucho más elegante). Si quisiera cambiar la label metiendo un argumento más a la función que sea una columna id, cambiaria esto así?, no? (Como si tuviera una columna a modo de rownames, pero con identificadores) aes(label = round(stat(y), 2)) -> aes(label = var_id
    – Galpaccru
    Commented el 26 ene. 2021 a las 22:07
  • He conseguido acercarme haciendo esta substitucion customPlot3 <- function(varName, df, paleta=mi_paleta, Var_by,var_id) { stat_summary( aes(label = df[stat(y),var_id]), geom = "text", fun = function(y) { o <- y[is_outlier(y)] if(length(o) == 0) NA else {o} }, hjust = -.8 ) Pero no queda bien, poniendome setosa donde es virgínica. @Patricio Moracho
    – Galpaccru
    Commented el 27 ene. 2021 a las 9:21
  • 1
    Pero "var_id" que valores tiene? Commented el 27 ene. 2021 a las 13:20
  • var_id es una columna dentro del mismo dataset que me funciona como un identificador (en el dataset para lo que lo quiero). En este caso con iris le puse "Species", por lo que me tendría que señalar los outlier con setosa setosa (los dos que hay en setosa), virginica virginica (los dos que hay en virginica). Si creara una variable de 1:150 para nombrar cada row con un número en iris, pues sería ese índice que es el que quiero usar para que me marque cuales lineas tienen el outlayer.
    – Galpaccru
    Commented el 27 ene. 2021 a las 13:33
  • La he actualizado para que quede algo más claro :D.
    – Galpaccru
    Commented el 27 ene. 2021 a las 19:40
0

Gracias a la primera respuesta he conseguido sacar una función. La dejo por aquí porque puede ser francamente de mucha utilidad (especialmente el tema de "sym", que es para transformar a símbolos un string conveniente).

Solución en funcion

Vamos a intentar transformarlo en funcion

library(dplyr)
library(ggplot2)
library(tibble)

library(ggrepel)



is_outlier <- function(x) {
  return(x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x))
  
  
}


mtcars2 <- mtcars %>% tibble::rownames_to_column(var="id") # Sacamos una variable identificador. ## Nuestro dataframe es dat.
# varid -> variable id
# var1 -> variable que se plotea
# varby -> variable que diferencia los boxplot
# vaird
ploteador <- function(dat =mtcars2,var1="drat",varby="cyl",varid="id") {

# varid = "id"
# var1 = "mpg"
# varby = "cyl"


dat <- dat %>% group_by(!!sym(varby)) %>% mutate(is_outlier=ifelse(is_outlier(!!sym(var1)),!!sym(var1), as.numeric(NA)))

dat$id[which(is.na(dat$is_outlier))] <- as.numeric(NA)


varid = "id"
ggplot(dat, aes(y=!!sym(var1), x=factor(!!sym(varby)))) + geom_boxplot() + geom_text_repel(aes(label=!!sym(varid)),na.rm=TRUE,nudge_y=0.05)


# p+geom_text_repel(data=filter(results, padj<0.05), aes(label=Gene))
}
ploteador()
ploteador(var1="mpg")

introducir la descripción de la imagen aquí introducir la descripción de la imagen aquí

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.