Pregunta ggplot: líneas percentiles por automatización de grupo


He encontrado el dplyr  %>% operador útil con transformaciones ggplot2 simples (sin recurrir a ggproto, que se requiere para extensiones ggplot2), p.ej.

library(ggplot2)
library(scales)
library(dplyr)

gg.histo.pct.by.group <- function(g, ...) {
  g + 
    geom_histogram(aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
    scale_y_continuous(labels = percent) + 
    ylab("% of total count by group")
}

data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))

g = ggplot(data, aes(carat, fill=color)) %>% 
  gg.histo.pct.by.group(binwidth=0.5, position="dodge")

Es común agregar algunas líneas de percentiles con etiquetas a estos tipos de gráficos, por ejemplo,

R plot

Una forma simple de hacer esto es

facts = data %>% 
  group_by(color) %>% 
  summarize(
    p50=quantile(carat, 0.5, na.rm=T), 
    p90=quantile(carat, 0.9, na.rm=T)
  )

ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2]

g +
  geom_vline(data=facts, aes(xintercept=p50, color=color), linetype="dashed", size=1) +
  geom_vline(data=facts, aes(xintercept=p90, color=color), linetype="dashed", size=1) +
  geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90) +
  geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90)

Me encantaría encapsular esto en algo como g %>% gg.percentile.x(c(.5, .9)) pero no he podido encontrar una buena manera de combinar el uso de aes_ o aes_string con el descubrimiento de las columnas de agrupación en el objeto gráfico para calcular los percentiles correctamente. Apreciaría algo de ayuda con eso.


5
2017-08-04 18:57


origen


Respuestas:


Creo que la forma más eficiente de crear la trama deseada consiste en tres pasos:

  1. Escribe dos estadísticas simples separadas (sección siguiente Creando una nueva estadística de https://cran.r-project.org/web/packages/ggplot2/vignettes/extending-ggplot2.html): uno para agregar líneas verticales en ubicaciones de percentiles y otro para agregar etiquetas de texto;
  2. Combine estadísticas escritas en el deseado con los parámetros necesarios;
  3. Usa los resultados del trabajo.

Así que la respuesta también consta de 3 partes.

Parte 1. La estadística para agregar líneas verticales en ubicaciones de percentiles debe calcular esos valores en función de los datos en el eje xy devolver el resultado en el formato apropiado. Aquí está el código:

library(ggplot2)

StatPercentileX <- ggproto("StatPercentileX", Stat,
  compute_group = function(data, scales, probs) {
    percentiles <- quantile(data$x, probs=probs)
    data.frame(xintercept=percentiles)
    },
  required_aes = c("x")
)

stat_percentile_x <- function(mapping = NULL, data = NULL, geom = "vline",
                              position = "identity", na.rm = FALSE,
                              show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPercentileX, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

Lo mismo ocurre con la estadística para agregar etiquetas de texto (la ubicación predeterminada se encuentra en la parte superior de la gráfica):

StatPercentileXLabels <- ggproto("StatPercentileXLabels", Stat,
  compute_group = function(data, scales, probs) {
    percentiles <- quantile(data$x, probs=probs)
    data.frame(x=percentiles, y=Inf,
               label=paste0("p", probs*100, ": ",
                            round(percentiles, digits=3)))
    },
  required_aes = c("x")
)

stat_percentile_xlab <- function(mapping = NULL, data = NULL, geom = "text",
                                     position = "identity", na.rm = FALSE,
                                     show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPercentileXLabels, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

Ya tenemos instrumentos muy potentes que se pueden usar de cualquier manera ggplot2 puede proporcionar (coloración, agrupamiento, facetado, etc.). Por ejemplo:

set.seed(1401)
plot_points <- data.frame(x_val=runif(100), y_val=runif(100),
                          g=sample(1:2, 100, replace=TRUE))
ggplot(plot_points, aes(x=x_val, y=y_val)) +
  geom_point() +
  stat_percentile_x(probs=c(0.25, 0.5, 0.75), linetype=2) +
  stat_percentile_xlab(probs=c(0.25, 0.5, 0.75), hjust=1, vjust=1.5, angle=90) +
  facet_wrap(~g)
# ggsave("Example_stat_percentile.png", width=10, height=5, units="in")

enter image description here

Parte 2 Aunque mantener capas separadas para líneas y etiquetas de texto parece bastante natural (a pesar de una pequeña ineficiencia computacional de calcular percentiles dos veces) agregar dos capas cada vez es bastante detallado. Especialmente para esto ggplot2 tiene una forma sencilla de combinar capas: colóquelas en la lista, que es la llamada a la función de resultado. El código es el siguiente:

stat_percentile_x_wlabels <- function(probs=c(0.25, 0.5, 0.75)) {
  list(
    stat_percentile_x(probs=probs, linetype=2),
    stat_percentile_xlab(probs=probs, hjust=1, vjust=1.5, angle=90)
  )
}

Con esta función, el ejemplo anterior se puede reproducir a través del siguiente comando:

ggplot(plot_points, aes(x=x_val, y=y_val)) +
  geom_point() +
  stat_percentile_x_wlabels() +
  facet_wrap(~g)

Tenga en cuenta que stat_percentile_x_wlabels toma probabilidades de los percentiles deseados que luego pasan a quantile función. Este es el lugar para especificarlos.

Parte 3 Usando nuevamente la idea de combinar capas, la trama en su pregunta puede reproducirse de la siguiente manera:

library(scales)
library(dplyr)

geom_histo_pct_by_group <- function() {
  list(geom_histogram(aes(y=unlist(lapply(unique(..group..),
                                          function(grp) {
                                            ..count..[..group..==grp] /
                                              sum(..count..[..group..==grp])
                                            }))),
                      binwidth=0.5, position="dodge"),
         scale_y_continuous(labels = percent),
         ylab("% of total count by group")
       )
}

data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))

ggplot(data, aes(carat, fill=color, colour=color)) +
  geom_histo_pct_by_group() +
  stat_percentile_x_wlabels(probs=c(0.5, 0.9))
# ggsave("Question_plot.png", width=10, height=6, unit="in")

enter image description here

Observaciones

  1. La forma en que se resuelve este problema aquí permite construir gráficos más complejos con líneas percentiles y etiquetas;

  2. Con cambio x a y (y viceversa), vline a hline, xintercept a yintercept en los lugares apropiados se pueden definir las mismas estadísticas para los datos del eje y;

  3. Por supuesto si te gusta usar %>% en lugar de ggplot2es + puede ajustar las estadísticas definidas en funciones tal como lo hizo en la publicación de la pregunta. Personalmente, no lo recomendaría porque va en contra del uso estándar de ggplot2.


10
2018-01-14 21:39



Pongo tu ejemplo en una función. Se puede analizar la evaluación no estándar en el factmarco de datos. (Nota: no me gusta nombrar un data.frame data así que lo cambié a mydata en el ejemplo).

mydata = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))

myFun <- function(df, X, col, bw, ...) {

  facts <- df %>% 
    group_by_(col) %>% 
    summarize_(
      p50= lazyeval::interp(~ quantile(var, 0.5, na.rm=TRUE), var = as.name(X)),
      p90= lazyeval::interp(~ quantile(var, 0.9, na.rm=TRUE), var = as.name(X))
    )

  gp <- ggplot(df, aes_string(x = X, fill = col)) + 
          geom_histogram( position="dodge", binwidth = bw, aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
          scale_y_continuous(labels = percent) + ylab("% of total count by group")

#  ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2] #doesnt work
  ymax = max(ggplot_build(g)$data[[1]]$ymax)

  gp + aes_string(color = col) +
    geom_vline(data=facts, aes_string(xintercept="p50", color = col), linetype="dashed", size=1) +
    geom_vline(data=facts, aes_string(xintercept="p90", color = col), linetype="dashed", size=1) +
    geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax), vjust=1.5, hjust=1, size=4, angle=90) +
    geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax), vjust=1.5, hjust=1, size=4, angle=90)
}

myFun(df = mydata, X = "carat", col = "color", bw = 0.5)

geom_histogram with NSE

Otra sugerencia si no desea poner comillas alrededor de sus variables en sus llamadas de función es configurar sus variables al principio de la función, a través de este responder.

myOtherFun <- function(data, var1, var2, ...) { 
  #Value instead of string
  internal.var1 <- eval(substitute(var1), data, parent.frame()) 
  internal.var2 <- eval(substitute(var2), data, parent.frame())
  ggplot(data, aes(x = internal.var1, y = internal.var2)) + geom_point()
}

myOtherFun(mtcars, mpg, hp)   #note: mpg and hp aren't in quotes
ggplot(mtcars, aes(x = mpg, y = hp)) + geom_point()  #same result

1
2018-01-14 02:13