在facet_wrap圖中添加「浮動」軸標籤

Question

我與this用戶具有相同的問題 - 我有一個「鋸齒狀」分面圖，其中底部行的面板數少於其他行，並且我希望x每列底部的軸標記。

該問題的建議解決方案是設置scales="free_x"。 （在ggplot 0.9.2.1中;我相信我在尋找的行爲在早期版本中是默認的）。在我的情況下，這是一個糟糕的解決方案：我的實際軸標籤將會很長，因此將它們放在每行下面會佔用太多房間。結果是這樣的：

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)) 

在評論here，Andrie表明，它可以在grid手動完成，但我不知道如何讓開始的。

Answer 1

如果我沒有記錯，那麼在如何將所有標籤添加到最後一列下的同一行以及如何將最後一個標籤提升到下一行時都存在問題。因此，這裏是這兩種情況的功能：

編輯：，因爲這是像print.ggplot的替代品（見getAnywhere(print.ggplot)）我已經添加了從它的一些線路保護功能。

編輯2：我提高了它多一點：無需指定nrow和ncol了，所有的面板圖可以印得。

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) 
} 

這裏是它的外觀

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") 

編輯3：

這是一種替代解決方案，上面的解決方案也很好。

當想要使用ggsave和facetAdjust時，會出現一些問題。因爲ggsave的源代碼中有兩個部分：print(plot)和default_name(plot)，所以需要ggplot的類別圖，以防手動提供文件名（根據?ggsave看起來它不應該工作）。因此，給定一個文件名，有一種解決方法（在某些情況下可能帶有副作用）：

首先，讓我們考慮實現浮動主軸效果的單獨函數。通常，它會返回一個gtable對象，但我們使用class(gtable) <- c("facetAdjust", "gtable", "ggplot")。以這種方式，它允許使用ggsave和print(plot)作品根據需要（參見下面的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 
} 

用於打印的功能，其僅由幾行從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) 
} 

實施例：

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