agregue tags de ejes “flotantes” en el diagtwig facet_wrap

Tengo el mismo problema que este usuario: tengo una ttwig 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 tags 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)) 

enter image description here

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

Si recuerdo bien, hubo preguntas sobre cómo agregar todas las tags a la misma línea debajo de la última columna y cómo levantar estas últimas tags 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) 

enter image description here

 facetAdjust(d, "down") 

enter image description here

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 diagtwig 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 
    Intereting Posts