r - 使用 gtable/grob 在 ggplot 中自定义标签元素位置

Question

我正在使用 R 中的 ggplot 为 DC 创建 GIS map 。我正在尝试自定义我的图例栏和标签。我可以使用 gtable_filter 移动图例键，但不能移动标签。我想像其他标签一样将最后一个标签“1”移到它的图例栏附近。任何帮助表示赞赏。 Image of the map

我正在使用以下 R 代码:

Data set looks like below

    head(d1930)

R Output:



     Simple feature collection with 6 features and 355 fields
            geometry type:  MULTIPOLYGON
            dimension:      XY
            bbox:           xmin: -77.0823 ymin: 38.89061 xmax: -77.0446 ymax: 38.94211
            epsg (SRID):    4326
            proj4string:    +proj=longlat +datum=WGS84 +no_defs
              fipsstate fipscounty  tract NHGISST NHGISCTY      GISJOIN    GISJOIN2 SHAPE_AREA SHAPE_LEN  X  GISJOIN.x.1 year cenv1_1 cenv8_1
            1        11        001 000001     110     0010 G11000100001 11000100001    1953567  8965.853  1 G11001000001 1930    7889    5885
            2        11        001 000002     110     0010 G11000100002 11000100002    1345844  5668.739 10 G11001000002 1930    6250    5164




       # # borrowed map theme and code from here
        # # https://timogrossenbacher.ch/2016/12/beautiful-thematic-maps-with-ggplot2-only/


            theme_map <- function(...) {
              theme_minimal() +
                theme(
                  text = element_text(family = "Ubuntu Regular", color = "#22211d"),
                  axis.line = element_blank(),
                  axis.text.x = element_blank(),
                  axis.text.y = element_blank(),
                  axis.ticks = element_blank(),
                  axis.title.x = element_blank(),
                  axis.title.y = element_blank(),
                  # panel.grid.minor = element_line(color = "#ebebe5", size = 0.2),
                  panel.grid.major = element_line(color = "white", size = 0.2),
                  panel.grid.minor = element_blank(),
                  plot.background = element_rect(fill = "white", color = NA),
                  panel.background = element_rect(fill = "white", color = NA),
                  legend.background = element_rect(fill = "white", color = NA),
                  panel.border = element_blank(),
                  ...
                )
            }


    # create the color vector

        my.cols <- brewer.pal(4, "Blues")

    # compute labels

        labels <- c()

    # put manual breaks as desired

        brks <- c(0,0.15,0.5,0.85,1)

    # round the labels (actually, only the extremes)

        for(idx in 1:length(brks)){
          labels <- c(labels,round(brks[idx + 1], 2))
        }

    # put labels into label vector

        labels <- labels[1:length(labels)-1]

    # define a new variable on the data set just as above

        d1930$brks <- cut(d1930$pAA, 
                          breaks = brks, 
                          include.lowest = TRUE, 
                          labels = labels)

    # define breaks scale and labels scales

        brks_scale <- levels(d1930$brks)
        labels_scale <- rev(brks_scale)

    # draw the plot with legend at the bottom

        p <- ggplot(d1930) + 
          geom_sf(aes(fill=brks),colour = "white")+
          coord_sf() +
          theme_map() +
          theme(legend.position = "bottom",legend.background = element_rect(color = NA)) 

    # provide manual scale and colors to the graph



    tester <- p +
          # now we have to use a manual scale, 
          # because only ever one number should be shown per label
          scale_fill_manual(
            # in manual scales, one has to define colors, well, we have done it earlier
            values = my.cols,
            breaks = rev(brks_scale),
            name = "Share of Population African American",
            drop = FALSE,
            labels = labels_scale,
            guide = guide_legend(
              direction = "horizontal",
              keyheight = unit(2.5, units = "mm"),
              keywidth = unit(85 / length(labels), units = "mm"),                      title.position = 'top',
              # shift the labels around, the should be placed 
              # exactly at the right end of each legend key
              title.hjust = 0.5,
              label.hjust = 1,                         ### change here 
              nrow = 1,
              byrow = T,
              # also the guide needs to be reversed
              reverse = T,
              label.position = "bottom"
            )
          )

        tester

        library(grid)
        library(gtable)

        extendLegendWithExtremes <- function(p){
          p_grob <- ggplotGrob(p)
          legend <- gtable_filter(p_grob, "guide-box")
          legend_grobs <- legend$grobs[[1]]$grobs[[1]]
          print(legend_grobs)
          # grab the first key of legend
          legend_first_key <- gtable_filter(legend_grobs, "key-3-1-1")
          legend_first_key$widths <- unit(2, units = "cm")
          # modify its width and x properties to make it longer
          legend_first_key$grobs[[1]]$width <- unit(1, units = "cm")
          legend_first_key$grobs[[1]]$x <- unit(1.6, units = "cm")              

          # last key of legend
          legend_last_key <- gtable_filter(legend_grobs, "key-3-4-1")
          legend_last_key$widths <- unit(2, units = "cm")

          # analogous
          legend_last_key$grobs[[1]]$width <- unit(1, units = "cm")
          legend_last_key$grobs[[1]]$x <- unit(0.5, units = "cm")

          # grab the last label so we can also shift its position 
    # below code is where i am stuck as this is not shifting the label
          legend_last_label <- gtable_filter(legend_grobs, "label-5-4")
          legend_last_label$widths <- unit(20, units = "cm")
          legend_last_label$grobs[[1]]$x <- unit(-10.1, units = "cm")
          legend_last_label$grobs[[1]]$width <- unit(10, units = "cm")

    # Insert new color legend back into the combined legend
          legend_grobs$grobs[legend_grobs$layout$name == "key-3-1-1"][[1]] <- 
            legend_first_key$grobs[[1]]
          legend_grobs$grobs[legend_grobs$layout$name == "key-3-4-1"][[1]] <- 
            legend_last_key$grobs[[1]]
          legend_grobs$grobs[legend_grobs$layout$name == "label-5-4"][[1]] <- 
            legend_last_label$grobs[[1]]  


          legend$grobs[[1]]$grobs[1][[1]] <- legend_grobs
          p_grob$grobs[p_grob$layout$name == "guide-box"][[1]] <- legend

          # the plot is now drawn using this grid function
          grid.newpage()
          grid.draw(p_grob)
          print(legend_grobs)
          # save the plot
          ggsave(paste0("~/Desktop/RA/",dateo,"_dc_1930.jpg"),
                              plot = p_grob, dpi = 300, width = 11, height = 8.5, units = c("in"))
        }

        extendLegendWithExtremes(tester)

Answer 1

可能是您没有准确捕捉到最后一个标签的坐标？例如 legend_last_label$grobs[[1]]$x是 NULL它应该返回 1npc .以下是您如何获得它的方法:

legend_last_label$grobs[[1]][["children"]][[1]][["children"]][[1]][["x"]]
#> [1] 1npc
# Overwrite it as you wish:
legend_last_label$grobs[[1]][["children"]][[1]][["children"]][[1]][["x"]] <- unit(-1, units = "cm")

也许使用 gPath 更安全每个 grob 的 s 以“捕获”它们，然后使用 editGrob 编辑它们功能。这是应用于您的情节的示例 tester :

g <- grid.force(ggplotGrob(tester)) # get all grobs and their components
grid.ls(g) # list the names of all grobs

图例位于底部的某处，标识为“guide-box.etc”

#>   guide-box.11-5-11-5
#>     legend.box.background.2-4-4-2
#>     guides.3-3-3-3
#>       background.1-7-7-1
#>       title.2-6-2-2
#>         guide.title.titleGrob.123
#>           GRID.text.121
#>       key-3-1-bg.4-2-4-2
#>       key-3-1-1.4-2-4-2
#>       key-3-2-bg.4-3-4-3
#>       key-3-2-1.4-3-4-3
#>       key-3-3-bg.4-4-4-4
#>       key-3-3-1.4-4-4-4
#>       key-3-4-bg.4-5-4-5
#>       key-3-4-1.4-5-4-5
#>       label-5-1.6-2-6-2
#>         guide.label.titleGrob.126
#>           GRID.text.124
#>       label-5-2.6-3-6-3
#>         guide.label.titleGrob.129
#>           GRID.text.127
#>       label-5-3.6-4-6-4
#>         guide.label.titleGrob.132
#>           GRID.text.130
#>       label-5-4.6-5-6-5
#>         guide.label.titleGrob.135
#>           GRID.text.133

您的最后一个标签被提及为:

#>       label-5-4.6-5-6-5
#>         guide.label.titleGrob.135
#>           GRID.text.133

现在我们需要构建 gPath s 对于每个 grob。也许有更简单的方法，但这是一种方法:

# delete "layout::" from raw gPath & add grob name at the end
gpaths <- paste(gsub(pattern = "layout::", 
                       replacement = "", 
                       x = grid.ls(g, print = FALSE)$gPath), 
                  grid.ls(g, print = FALSE)$name, 
                  sep = "::")

标签文本的路径是:

gpaths[grepl("guide-box.*label-5-4.*GRID\\.text.*", gpaths)]
#> [1] "guide-box.11-5-11-5::guides.3-3-3-3::label-5-4.6-5-6-5::guide.label.titleGrob.135::GRID.text.133"

所以，有了路径，我们就可以编辑grob了，也就是把标签向左移动:

g <- editGrob(grob = g, 
              gPath = gpaths[grepl("guide-box.*label-5-4.*GRID.text.*", gpaths)], 
              x = unit(-1, "cm"))
plot(g)

此外，您可以编辑键的宽度和位置。以下是编辑最右侧键的方法:

g <- editGrob(grob = g, 
              gPath = gpaths[grepl("guide-box.*key-3-4-1.*", gpaths)], 
              x = unit(0.5, "cm"),
              width = unit(1, "cm"))
plot(g)

另外，我认为你应该替换 labels <- labels[1:length(labels)-1]与 labels <- labels[-length(labels)] ;否则我会收到来自 cut 的错误消息函数，当你构建时 d1930$brks