ggplot：按面不同的scale_fill_gradient

Question

我正在使用ggplot()和geom_sf()来绘制一个多面映射（见下面的代码）和沿着scale_fill_gradient()变量（value在下面的示例中）的颜色单位，然后再用另一个变量（group）进行多面化。这有效；但现在我想根据切面更改渐变高端（不是中点或更低）的颜色。基于这个color_high答案，我已将其保存在绘图数据框中的单独列 ( ) 中。但是，我无法将其转换为绘图比例。

\n

有人能指出我正确的方向吗？下面是具有单个填充渐变的工作代码。预期输出具有高值，如color_high（A 组中的红色，B 组中的绿色）中所定义。

\n

library(sf)\nlibrary(tidyverse)\ntheme_set(theme_bw())\nlibrary(giscoR)\n\nger_fedstates <- gisco_get_nuts(nuts_level = 1, resolution = 10, country = "Germany", year = 2021)\n\ndat <- read.table(text = "state value group\n                          Sachsen 10 a\n                          Sachsen 1 b\n                          Bayern 3 a\n                          Bayern 30 b\n                          Rheinland-Pfalz 50 a\n                          Rheinland-Pfalz 50 b\n                          Saarland 70 a\n                          Saarland 70 b\n                          Schleswig-Holstein 9 a\n                          Schleswig-Holstein 90 b\n                          Niedersachsen  100 a\n                          Niedersachsen  100 b\n                          Nordrhein-Westfalen 80 a\n                          Nordrhein-Westfalen 80 b\n                          Baden-W\xc3\xbcrttemberg 60 a\n                          Baden-W\xc3\xbcrttemberg 60 b\n                          Brandenburg 40 a\n                          Brandenburg 40 b\n                          Mecklenburg-Vorpommern 20 a\n                          Mecklenburg-Vorpommern 20 b\n                          Bremen 40 a\n                          Bremen 40 b\n                          Hamburg 60 a\n                          Hamburg 60 b\n                          Hessen 15 a\n                          Hessen 15 b\n                          Berlin 10 a\n                          Berlin 10 b\n                          Th\xc3\xbcringen 80 a\n                          Th\xc3\xbcringen 80 b\n                          Sachsen-Anhalt 20 a\n                          Sachsen-Anhalt 20 b", header = T) %>% \n  mutate(color_high = case_when(group=="a"~"red", group=="b"~"green"))\n\nplot_df <- full_join(ger_fedstates, dat, by=c("NUTS_NAME" = "state"))\n\nplot_df %>% \n  ggplot() +\n  geom_sf(aes(fill = value)) +\n  theme(axis.text.x = element_blank(),\n        axis.text.y = element_blank(),\n        axis.line.x = element_blank(),\n        axis.line.y = element_blank(),\n        legend.position = "right",\n        legend.title.align = 0) +\n  scale_fill_gradient2(low = "grey40",\n                       mid = "white",\n                       high = "#0000ff", # this should be the value of "color_high" column\n                       midpoint=50,\n                       guide = "colourbar",\n                       aesthetics = "fill") + \n  facet_wrap(~group, labeller = labeller(group=c(a="Group A", b="Group B", c="Group C")))\n

\n

Answer 1

我认为每个方面不可能有不同的比例，但您可以创建一个循环来为每个组创建一个图，然后用于将patchwork它们放在一起（尽管如果您有很多组，这会变得很烦人）：

\n

library(sf)\n#> Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE\nlibrary(tidyverse)\ntheme_set(theme_bw())\nlibrary(giscoR)\nlibrary(patchwork)\n\nger_fedstates <- gisco_get_nuts(nuts_level = 1, resolution = 10, country = "Germany", year = 2021)\n\ndat <- read.table(text = "state value group\n                        Sachsen 10 a\n                        Sachsen 1 b\n                        Bayern 3 a\n                        Bayern 30 b\n                        Rheinland-Pfalz 50 a\n                        Rheinland-Pfalz 50 b\n                        Saarland 70 a\n                        Saarland 70 b\n                        Schleswig-Holstein 9 a\n                        Schleswig-Holstein 90 b\n                        Niedersachsen  100 a\n                        Niedersachsen  100 b\n                        Nordrhein-Westfalen 80 a\n                        Nordrhein-Westfalen 80 b\n                        Baden-W\xc3\xbcrttemberg 60 a\n                        Baden-W\xc3\xbcrttemberg 60 b\n                        Brandenburg 40 a\n                        Brandenburg 40 b\n                        Mecklenburg-Vorpommern 20 a\n                        Mecklenburg-Vorpommern 20 b\n                        Bremen 40 a\n                        Bremen 40 b\n                        Hamburg 60 a\n                        Hamburg 60 b\n                        Hessen 15 a\n                        Hessen 15 b\n                        Berlin 10 a\n                        Berlin 10 b\n                        Th\xc3\xbcringen 80 a\n                        Th\xc3\xbcringen 80 b\n                        Sachsen-Anhalt 20 a\n                        Sachsen-Anhalt 20 b", header = T) %>% \n  mutate(color_high = case_when(group=="a"~"red", group=="b"~"green"))\n\n\nplot_df <- full_join(ger_fedstates, dat, by=c("NUTS_NAME" = "state"))\n#> Warning in sf_column %in% names(g): Each row in `x` is expected to match at most 1 row in `y`.\n#> \xe2\x84\xb9 Row 1 of `x` matches multiple rows.\n#> \xe2\x84\xb9 If multiple matches are expected, set `multiple = "all"` to silence this\n#>   warning.\n\nplots <- list()\nfor (i in unique(plot_df$group)) {\n  tmp <- plot_df %>% \n    filter(group == i)\n  \n  high_color <- ifelse(unique(tmp$group) == "a", "red", "green")\n  \n  plots[[i]] <- tmp %>%\n    ggplot() +\n    geom_sf(aes(fill = value)) +\n    theme(axis.text.x = element_blank(),\n          axis.text.y = element_blank(),\n          axis.line.x = element_blank(),\n          axis.line.y = element_blank(),\n          legend.position = "right",\n          legend.title.align = 0) +\n    scale_fill_gradient2(\n      low = "grey40",\n      mid = "white",\n      high = high_color, # this should be the value of "color_high" column\n      midpoint=50,\n      guide = "colourbar",\n      aesthetics = "fill"\n    ) +\n    labs(title = paste0("Group ", i))\n}\n\n\npurrr::reduce(plots, `+`)\n# can also use wrap_plots(plots)\n

\n

\n