facet_grid - agregue etiquetas de ejes "flotantes" en el diagrama facet_wrap

plotly facet_wrap

Question

Tengo el mismo problema que this usuario: tengo una trama facetada ''irregular'', en la que la fila inferior tiene menos paneles que las otras filas, y me gustaría tener marcas de eje x en la parte inferior de cada columna.

La solución sugerida para ese problema era establecer scales="free_x" . (En ggplot 0.9.2.1; creo que el comportamiento que estoy buscando era el predeterminado en versiones anteriores). Esa es una solución pobre en mi caso: mis etiquetas de ejes reales serán bastante largas, por lo que ponerlas debajo de cada fila ocupará demasiado habitación. Los resultados son algo como esto:

 x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5]))
 y <- rnorm(length(x))
 l <- gl(5, 3, 15)
 d <- data.frame(x=x, y=y, l=l)
 ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") + 
   theme(axis.text.x=element_text(angle=90, hjust=1))

En un comentario here , Andrie sugiere que se puede hacer manualmente en la grid pero no tengo idea de cómo comenzar con eso.

Answer 1

Si recuerdo bien, hubo preguntas sobre cómo agregar todas las etiquetas a la misma línea debajo de la última columna y cómo levantar estas últimas etiquetas hasta la siguiente fila. Así que aquí está la función para ambos casos:

Editar: ya que esto es como un sustituto de print.ggplot (ver getAnywhere(print.ggplot) ) he agregado algunas líneas para preservar la funcionalidad.

Edición 2: lo he mejorado un poco más: ya no es necesario especificar nrow y ncol , también se pueden imprimir trazados con todos los paneles.

library(grid)
# pos - where to add new labels
# newpage, vp - see ?print.ggplot
facetAdjust <- function(x, pos = c("up", "down"), 
                        newpage = is.null(vp), vp = NULL)
{
  # part of print.ggplot
  ggplot2:::set_last_plot(x)
  if(newpage)
    grid.newpage()
  pos <- match.arg(pos)
  p <- ggplot_build(x)
  gtable <- ggplot_gtable(p)
  # finding dimensions
  dims <- apply(p$panel$layout[2:3], 2, max)
  nrow <- dims[1]
  ncol <- dims[2]
  # number of panels in the plot
  panels <- sum(grepl("panel", names(gtable$grobs)))
  space <- ncol * nrow
  # missing panels
  n <- space - panels
  # checking whether modifications are needed
  if(panels != space){
    # indices of panels to fix
    idx <- (space - ncol - n + 1):(space - ncol)
    # copying x-axis of the last existing panel to the chosen panels 
    # in the row above
    gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
    if(pos == "down"){
      # if pos == down then shifting labels down to the same level as 
      # the x-axis of last panel
      rows <- grep(paste0("axis_b//-[", idx[1], "-", idx[n], "]"), 
                   gtable$layout$name)
      lastAxis <- grep(paste0("axis_b//-", panels), gtable$layout$name)
      gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
    }
  }
  # again part of print.ggplot, plotting adjusted version
  if(is.null(vp)){
    grid.draw(gtable)
  }
  else{
    if (is.character(vp)) 
      seekViewport(vp)
    else pushViewport(vp)
    grid.draw(gtable)
    upViewport()
  }
  invisible(p)
}

Y así es como se ve

d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
  xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) + 
  facet_wrap(~ color)
facetAdjust(d)

facetAdjust(d, "down")

Editar 3:

Esta es una solución alternativa, la de arriba está bien también.

Hay algunos problemas cuando uno quiere usar ggsave junto con facetAdjust . Se requiere un diagrama de clase de ggplot debido a dos partes en el código fuente de ggsave : print(plot) y default_name(plot) en caso de que uno no proporcione un nombre de archivo manualmente (de acuerdo con ?ggsave parece que no se supone que trabajo, sin embargo). Por lo tanto, dado un nombre de archivo, hay una solución alternativa (posiblemente con efectos secundarios en algunos casos):

Primero, consideremos la función separada que logra el efecto principal del eje flotante. Normalmente, devolvería un objeto gtable , sin embargo usamos class(gtable) <- c("facetAdjust", "gtable", "ggplot") . De esta manera, está permitido usar ggsave e print(plot) funciona como se requiere (ver más abajo para print.facetAdjust )

facetAdjust <- function(x, pos = c("up", "down"))
{
  pos <- match.arg(pos)
  p <- ggplot_build(x)
  gtable <- ggplot_gtable(p); dev.off()
  dims <- apply(p$panel$layout[2:3], 2, max)
  nrow <- dims[1]
  ncol <- dims[2]
  panels <- sum(grepl("panel", names(gtable$grobs)))
  space <- ncol * nrow
  n <- space - panels
  if(panels != space){
    idx <- (space - ncol - n + 1):(space - ncol)
    gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
    if(pos == "down"){
      rows <- grep(paste0("axis_b//-[", idx[1], "-", idx[n], "]"), 
                   gtable$layout$name)
      lastAxis <- grep(paste0("axis_b//-", panels), gtable$layout$name)
      gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
    }
  }
  class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}

La función para imprimir difiere solo por unas pocas líneas de ggplot2:::print.ggplot :

print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
  if(newpage)
    grid.newpage()
  if(is.null(vp)){
    grid.draw(x)
  } else {
    if (is.character(vp)) 
      seekViewport(vp)
    else pushViewport(vp)
    grid.draw(x)
    upViewport()
  }
  invisible(x)
}

Ejemplo:

d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
  xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) + 
  facet_wrap(~ color)
p <- facetAdjust(d) # No output
print(p) # The same output as with the old version of facetAdjust()
ggsave("name.pdf", p) # Works, a filename is necessary