How to position strip labels in facet_wrap like in facet_grid

后端 未结 2 1151
被撕碎了的回忆
被撕碎了的回忆 2020-12-03 08:55

I would like to remove the redundancy of strip labels when using facet_wrap() and faceting with two variables and both scales free.

For example, this

相关标签:
2条回答
  • 2020-12-03 09:31

    I am not sure you can do this by just using facet_wrap, so probably your attempt is the way to go. But IMO it needs an improvement. Presently, you are missing actual y-lab (sales) and it kinda misguides what is plotted in y- axis

    You could improve what you are doing by adding another plot title row by using gtable and grid.

    p1 <- ggplot(dt[dt$year == 2000,], aes(median, sales)) +
      geom_point() +
      facet_wrap("month", scales = "free") +
      theme(axis.title.x = element_blank())
    
    p2 <- ggplot(dt[dt$year == 2001,], aes(median, sales)) +
      geom_point() +
      facet_wrap("month", scales = "free") +
      theme(axis.title.x = element_blank())
    
    p3 <- ggplot(dt[dt$year == 2002,], aes(median, sales)) +
      geom_point() +
      facet_wrap("month", scales = "free")
    

    Note that the labs are removed from the above plots.

    if ( !require(grid) )    { install.packages("grid");    library(grid) }
    if ( !require(gtable ) )   { install.packages("gtable");    library(gtable) }
    
    z1 <- ggplotGrob(p1) # Generate a ggplot2 plot grob
    z1 <- gtable_add_rows(z1, unit(0.6, 'cm'), 2) # add new rows in specified position
    
    z1 <- gtable_add_grob(z1,
                        list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
                             textGrob("2000", gp = gpar(col = "black",cex=0.9))),
                        t=2, l=4, b=3, r=13, name = paste(runif(2))) #add grobs into the table
    

    Note that in step 3, getting the exact values for t (top extent), l(left extent), b (bottom extent) and r(right extent) might need trial and error method

    Now repeat the above steps for p2 and p3

    z2 <- ggplotGrob(p2)
    z2 <- gtable_add_rows(z2, unit(0.6, 'cm'), 2) 
    
    z2 <- gtable_add_grob(z2,
                          list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
                               textGrob("2001", gp = gpar(col = "black",cex=0.9))),
                          t=2, l=4, b=3, r=13, name = paste(runif(2))) 
    
    z3 <- ggplotGrob(p3) 
    z3 <- gtable_add_rows(z3, unit(0.6, 'cm'), 2)
    
    z3 <- gtable_add_grob(z3,
                          list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
                               textGrob("2002", gp = gpar(col = "black",cex=0.9))),
                          t=2, l=4, b=3, r=13, name = paste(runif(2))) 
    

    finally, plotting

    plot_grid(z1, z2, z3, nrow = 3)
    

    You can also have the years indicated in the column like in facet_grid instead of row. In that case, you have to add a column by using gtable_add_cols. But make sure to (a) add the column at the correct position in step-2, and (b) get the correct values for t, l, b and r in step-3.

    0 讨论(0)
  • 2020-12-03 09:35

    This does not seem easy, but one way is to use grid graphics to insert panel strips from a facet_grid plot into one created as a facet_wrap. Something like this:

    First lets create two plots using facet_grid and facet_wrap.

    dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]
    
    g1 = ggplot(dt, aes(median, sales)) +
      geom_point() +
      facet_wrap(c("year", "month"), scales = "free") +
      theme(strip.background = element_blank(),
            strip.text = element_blank())
    
    g2 = ggplot(dt, aes(median, sales)) +
      geom_point() +
      facet_grid(c("year", "month"), scales = "free")
    

    Now we can fairly easily replace the top facet strips of g1 with those from g2

    library(grid)
    library(gtable) 
    gt1 = ggplot_gtable(ggplot_build(g1))
    gt2 = ggplot_gtable(ggplot_build(g2))
    gt1$grobs[grep('strip-t.+1$', gt1$layout$name)] = gt2$grobs[grep('strip-t', gt2$layout$name)]
    grid.draw(gt1)
    

    Adding the right hand panel strips need us to first add a new column in the grid layout, then paste the relevant strip grobs into it:

    gt.side1 = gtable_filter(gt2, 'strip-r-1')
    gt.side2 = gtable_filter(gt2, 'strip-r-2')
    gt.side3 = gtable_filter(gt2, 'strip-r-3')
    
    gt1 = gtable_add_cols(gt1, widths=gt.side1$widths[1], pos = -1)
    gt1 = gtable_add_grob(gt1, zeroGrob(), t = 1, l = ncol(gt1), b=nrow(gt1))
    
    panel_id <- gt1$layout[grep('panel-.+1$', gt1$layout$name),]
    gt1 = gtable_add_grob(gt1, gt.side1, t = panel_id$t[1], l = ncol(gt1))
    gt1 = gtable_add_grob(gt1, gt.side2, t = panel_id$t[2], l = ncol(gt1))
    gt1 = gtable_add_grob(gt1, gt.side3, t = panel_id$t[3], l = ncol(gt1))
    
    grid.newpage()
    grid.draw(gt1)
    

    0 讨论(0)
提交回复
热议问题