ggplot2: Ajout d'informations sur la taille de l'échantillon aux étiquettes de graduation de l'axe x

Question

Cette question est liée à Créer un geom personnalisé pour calculer des statistiques récapitulatives et les afficher * en dehors * de la région de traçage (REMARQUE: toutes les fonctions ont été simplifiées; aucune vérification d'erreur pour les types d'objets, les NA, etc.)

Dans la base R, il est assez facile de créer une fonction qui produit un diagramme à bandes avec la taille d'échantillon indiquée sous chaque niveau de la variable de regroupement: vous pouvez ajouter les informations de taille d'échantillon à l'aide de la fonction mtext():

stripchart_w_n_ver1 <- function(data, x.var, y.var) {
    x <- factor(data[, x.var])
    y <- data[, y.var]
# Need to call plot.default() instead of plot because 
# plot() produces boxplots when x is a factor.
    plot.default(x, y, xaxt = "n",  xlab = x.var, ylab = y.var)
    levels.x <- levels(x)
    x.ticks <- 1:length(levels(x))
    axis(1, at = x.ticks, labels = levels.x)
    n <- sapply(split(y, x), length)
    mtext(paste0("N=", n), side = 1, line = 2, at = x.ticks)
}

stripchart_w_n_ver1(mtcars, "cyl", "mpg")

ou vous pouvez ajouter les informations de taille d'échantillon aux étiquettes de graduation de l'axe des x en utilisant la fonction axis():

stripchart_w_n_ver2 <- function(data, x.var, y.var) {
    x <- factor(data[, x.var])
    y <- data[, y.var]
# Need to set the second element of mgp to 1.5 
# to allow room for two lines for the x-axis tick labels.
    o.par <- par(mgp = c(3, 1.5, 0))
    on.exit(par(o.par))
# Need to call plot.default() instead of plot because 
# plot() produces boxplots when x is a factor.
    plot.default(x, y, xaxt = "n", xlab = x.var, ylab = y.var)
    n <- sapply(split(y, x), length)
    levels.x <- levels(x)
    axis(1, at = 1:length(levels.x), labels = paste0(levels.x, "\nN=", n))
}

stripchart_w_n_ver2(mtcars, "cyl", "mpg")

Bien que ce soit une tâche très facile dans la base R, elle est extrêmement complexe dans ggplot2 car il est très difficile d'obtenir les données utilisées pour générer le tracé, et bien qu'il existe des fonctions équivalentes à axis() (par exemple , scale_x_discrete, Etc.) il n'y a pas d'équivalent à mtext() qui vous permet de placer facilement du texte aux coordonnées spécifiées dans les marges.

J'ai essayé d'utiliser la fonction stat_summary() intégrée pour calculer la taille des échantillons (c.-à-d. fun.y = "length"), Puis j'ai placé ces informations sur les étiquettes des graduations de l'axe des x, mais pour autant que je sache, vous ne pouvez pas extraire les tailles d'échantillons, puis les ajouter aux étiquettes de graduation de l'axe x à l'aide de la fonction scale_x_discrete(), vous devez dire à stat_summary() quelle géom vous voulez qu'elle utilise. Vous pouvez définir geom="text", Mais vous devez ensuite fournir les étiquettes, et le fait est que les étiquettes doivent être les valeurs des tailles d'échantillon, ce que stat_summary() calcule mais que vous ne peut pas atteindre (et vous devrez également spécifier où vous souhaitez placer le texte, et encore une fois, il est difficile de savoir où le placer de sorte qu'il se trouve directement sous les étiquettes de graduation de l'axe x).

La vignette "Extension de ggplot2" ( http://docs.ggplot2.org/dev/vignettes/extending-ggplot2.html ) vous montre comment créer votre propre fonction stat qui vous permet d'accéder directement à les données, mais le problème est que vous devez toujours définir un geom pour aller avec votre fonction stat (c'est-à-dire que ggplot pense que vous voulez tracer ces informations dans le tracé, pas dans les marges); pour autant que je sache, vous ne pouvez pas prendre les informations que vous calculez dans votre fonction de statistique personnalisée, ne pas tracer quoi que ce soit dans la zone de traçage, et plutôt transmettre les informations à une fonction d'échelles comme scale_x_discrete(). Voici mon essai de le faire de cette façon; le mieux que j'ai pu faire était de placer les informations sur la taille de l'échantillon à la valeur minimale de y pour chaque groupe:

StatN <- ggproto("StatN", Stat,
    required_aes = c("x", "y"), 
    compute_group = function(data, scales) {
    y <- data$y
    y <- y[!is.na(y)]
    n <- length(y)
    data.frame(x = data$x[1], y = min(y), label = paste0("n=", n))
    }
)

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

ggplot(mtcars, aes(x = factor(cyl), y = mpg)) + geom_point() + stat_n()

Je pensais avoir résolu le problème en créant simplement une fonction wrapper dans ggplot:

ggstripchart <- function(data, x.name, y.name,  
    point.params = list(), 
    x.axis.params = list(labels = levels(x)), 
    y.axis.params = list(), ...) {
    if(!is.factor(data[, x.name]))
    data[, x.name] <- factor(data[, x.name])
    x <- data[, x.name]
    y <- data[, y.name]
    params <- list(...)
    point.params    <- modifyList(params, point.params)
    x.axis.params   <- modifyList(params, x.axis.params)
    y.axis.params   <- modifyList(params, y.axis.params)

    point <- do.call("geom_point", point.params)

    stripchart.list <- list(
        point, 
        theme(legend.position = "none")
    )

    n <- sapply(split(y, x), length)
    x.axis.params$labels <- paste0(x.axis.params$labels, "\nN=", n)
    x.axis <- do.call("scale_x_discrete", x.axis.params)
    y.axis <- do.call("scale_y_continuous", y.axis.params)
    stripchart.list <- c(stripchart.list, x.axis, y.axis)           

    ggplot(data = data, mapping = aes_string(x = x.name, y = y.name)) + stripchart.list
}


ggstripchart(mtcars, "cyl", "mpg")

Cependant, cette fonction ne fonctionne pas correctement avec le facettage. Par exemple:

ggstripchart(mtcars, "cyl", "mpg") + facet_wrap(~am)

montre les tailles d'échantillon pour les deux facettes combinées pour chaque facette. Je devrais intégrer la facettisation dans la fonction wrapper, ce qui va à l'encontre du point d'essayer d'utiliser tout ce que ggplot a à offrir.

Si quelqu'un a des idées sur ce problème, je vous en serais reconnaissant. Merci beaucoup pour votre temps!

Answer 1

Ma solution est peut-être un peu simple mais elle fonctionne bien.

Étant donné un exemple de facettage par am, je commence par créer des étiquettes à l'aide de paste et \n.

mtcars2 <- mtcars %>% 
  group_by(cyl, am) %>% mutate(n = n()) %>% 
  mutate(label = paste0(cyl,'\nN = ',n))

J'utilise ensuite ces étiquettes au lieu de cyl dans le code ggplot

ggplot(mtcars2,
   aes(x = factor(label), y = mpg, color = factor(label))) + 
  geom_point() + 
  xlab('cyl') + 
  facet_wrap(~am, scales = 'free_x') +
  theme(legend.position = "none")

Pour produire quelque chose comme la figure ci-dessous.

Answer 2

Vous pouvez imprimer les nombres sous les étiquettes de l'axe des x à l'aide de geom_text si vous désactivez l'écrêtage, mais vous devrez probablement modifier le placement. J'ai inclus un paramètre "Nudge" pour cela dans le code ci-dessous. En outre, la méthode ci-dessous est destinée aux cas où toutes les facettes (le cas échéant) sont des facettes de colonne.

Je me rends compte que vous voulez en fin de compte du code qui fonctionnera dans un nouveau geom, mais peut-être que les exemples ci-dessous peuvent être adaptés pour une utilisation dans un geom.

library(ggplot2)
library(dplyr)

pgg = function(dat, x, y, facet=NULL, Nudge=0.17) {

  # Convert x-variable to a factor
  dat[,x] = as.factor(dat[,x])

  # Plot points
  p = ggplot(dat, aes_string(x, y)) +
    geom_point(position=position_jitter(w=0.3, h=0)) + theme_bw() 

  # Summarise data to get counts by x-variable and (if present) facet variables
  dots = lapply(c(facet, x), as.symbol)
  nn = dat %>% group_by_(.dots=dots) %>% tally

  # If there are facets, add them to the plot
  if (!is.null(facet)) {
    p = p + facet_grid(paste("~", paste(facet, collapse="+")))
  }

  # Add counts as text labels
  p = p + geom_text(data=nn, aes(label=paste0("N = ", nn$n)),
                    y=min(dat[,y]) - Nudge*1.05*diff(range(dat[,y])), 
                    colour="grey20", size=3.5) +
    theme(axis.title.x=element_text(margin=unit(c(1.5,0,0,0),"lines")))

  # Turn off clipping and return plot
  p <- ggplot_gtable(ggplot_build(p))
  p$layout$clip[p$layout$name=="panel"] <- "off"
  grid.draw(p)

}

pgg(mtcars, "cyl", "mpg")
pgg(mtcars, "cyl", "mpg", facet=c("am","vs"))

Une autre option, potentiellement plus flexible, consiste à ajouter les nombres au bas du panneau de tracé. Par exemple:

pgg = function(dat, x, y, facet_r=NULL, facet_c=NULL) {

  # Convert x-variable to a factor
  dat[,x] = as.factor(dat[,x])

  # Plot points
  p = ggplot(dat, aes_string(x, y)) +
    geom_point(position=position_jitter(w=0.3, h=0)) + theme_bw() 

  # Summarise data to get counts by x-variable and (if present) facet variables
  dots = lapply(c(facet_r, facet_c, x), as.symbol)
  nn = dat %>% group_by_(.dots=dots) %>% tally

  # If there are facets, add them to the plot
  if (!is.null(facet_r) | !is.null(facet_c)) {

    facets = paste(ifelse(is.null(facet_r),".",facet_r), " ~ " , 
                   ifelse(is.null(facet_c),".",facet_c))

    p = p + facet_grid(facets)
  }

  # Add counts as text labels
  p + geom_text(data=nn, aes(label=paste0("N = ", nn$n)),
                y=min(dat[,y]) - 0.15*min(dat[,y]), colour="grey20", size=3) +
    scale_y_continuous(limits=range(dat[,y]) + c(-0.1*min(dat[,y]), 0.01*max(dat[,y])))
}

pgg(mtcars, "cyl", "mpg")
pgg(mtcars, "cyl", "mpg", facet_c="am")
pgg(mtcars, "cyl", "mpg", facet_c="am", facet_r="vs")

Answer 3

J'ai mis à jour le package EnvStats pour inclure un stat appelé stat_n_text qui ajoutera la taille de l'échantillon (le nombre de valeurs uniques y - sous chaque valeur unique x - valeur. Voir fichier d'aide pour stat_n_text pour plus d'informations et une liste d'exemples. Voici un exemple simple:

library(ggplot2)
library(EnvStats)

p <- ggplot(mtcars, 
  aes(x = factor(cyl), y = mpg, color = factor(cyl))) + 
  theme(legend.position = "none")

p + geom_point() + 
  stat_n_text() + 
  labs(x = "Number of Cylinders", y = "Miles per Gallon")