按组手动填充具有多个比例的geom_tile

Question

我有以下当前输出：

​

我的目标是像这样的颜色，但只填充到最大级别(例如，填充停止在当前级别)：

​

​

创建它所需的数据是：

df <- tribble(~Question_Code,   ~RespondentLevel,
"Engagement - Inclusion",   5,
"External engagement - policies",   2,
"External engagement - technology", 5,
"Community data ",  5,
"Internal engagement",  5,
"Internal use of technology",   4,
"Familiarity/Alignment",    5,
"Environmental impacts",    5,
"Innovation",   2,
"Use of open-source technology",    2,
"Regulation of hardware & software",    5,
"In-house technical capacity",  5,
"Infrastructure procurement",   5,
"Algorithmic Error & Bias", 2,
"Control: Privacy", 5,
"Accountability in Governance Structures",  3,
"Open procurement", 5,
"Use in decision-making",   1,
"Accountability",   1,
"External Control", 4,
"Internal Control", 2,
"Open Data",    2)
levels <-  c("Open Data","Internal Control","External Control","Accountability",
             "Use in decision-making","Open procurement","Accountability in Governance Structures","Control: Privacy",
             "Algorithmic Error & Bias","Infrastructure procurement","In-house technical capacity",
             "Regulation of hardware & software","Use of open-source technology","Innovation",
             "Environmental impacts","Familiarity/Alignment",
             "Internal use of technology","Internal engagement","Community data",
             "External engagement - technology","External engagement - policies","Engagement - Inclusion")

df <- df %>% mutate(Domain = c(as.character((rep("Domain 1", 5))),
                  as.character(rep("Domain 2", 4)),
                  as.character(rep("Domain 3", 6)),
                  as.character(rep("Domain 4", 7))))

而对于ggplot：

df %>% 
ggplot(aes(x = RespondentLevel, y = fct_rev(Question_Code))) +
  geom_tile() +
  theme_minimal(16)

要填充的颜色，我正在使用：

with each colour corresponding to a domain, and each shade to a level:
Greens <- c("#edf8e9", "#bae4b3", "#74c476", "#31a354", "#006d2c")

Reds <- c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15")

Yellows <- c("#ffffeb","#ffff9d","#ffff89", "#ffff4e", "#ffff14")

Blues <- c("#eff3ff","#bdd7e7","#6baed6","#3182bd",  "#08519c")

编辑: geom_bar也能做到这一点，但不会被渐变分解。尝试使用this function

ColourPalleteMulti <- function(df, group, subgroup){

  # Find how many colour categories to create and the number of colours in each
  categories <- aggregate(as.formula(paste(subgroup, group, sep="~" )), df, function(x) length(unique(x)))
  category.start <- (scales::hue_pal(l = 100)(nrow(categories))) # Set the top of the colour pallete
  category.end  <- (scales::hue_pal(l = 40)(nrow(categories))) # set the bottom

  # Build Colour pallette
  colours <- unlist(lapply(1:nrow(categories),
                           function(i){
                             colorRampPalette(colors = c(category.start[i], category.end[i]))(categories[i,2])}))
  return(colours)
}

colours <- ColourPalleteMulti(df, "Domain", "RespondentLevel") 

df %>% 
  ggplot(aes(x = fct_rev(Question_Code), y = RespondentLevel))+
  geom_bar(stat = "identity", aes(fill = Domain), alpha = .9) +
  coord_flip() +
  theme_minimal(16)+
  xlab(" ") +
  ggtitle("Baseline Report Card Sample Community")+
  scale_fill_manual("RespondentLevel", values = colours)+
  theme(legend.title = element_text(size = 14),
        legend.position = "none",
        legend.text = element_text(size = 14),
        plot.title = element_text(size=18, hjust = 0.5),
        plot.caption = element_text(size = 12, hjust = 1),
        axis.text.y = element_text(hjust = 0),
        panel.grid = element_line(colour = "#F0F0F0"),
        plot.margin = unit(c(1,1,0.5,1), "cm"))

​

​

抱歉，如果可能的话，可以调整一下。

Answer 1

这里有一些技巧的选择。首先，为了获得每个问题的完整级别集，以便在数据中不存在差距，我使用了tidyr::complete。这就是我要用到的数据框架。

library(ggplot2)
library(dplyr)
library(tidyr)
library(purrr)
library(patchwork)

df_full <- df %>%
  complete(nesting(Domain, Question_Code), RespondentLevel) %>%
  mutate(RespondentLevel = as.character(RespondentLevel)) 

更简单的选择是通过更改alpha来近似渐变，并基于域设置色调(红色、绿色等)。这将放弃您选择的其他颜色，而只使用每个调色板中最后一个最暗的颜色。

为此，我列出了所有调色板的列表。在设置填充时，map_chr(palettes, 5)提取每个列表的第5个元素，这是每个列表中最暗的颜色。您可能希望调整或删除其中一个或两个图例。

palettes <- list(Greens, Reds, Yellows, Blues)

ggplot(df_full, aes(x = RespondentLevel, y = Question_Code, fill = Domain, alpha = RespondentLevel)) +
  geom_tile() +
  theme_minimal() +
  facet_grid(rows = vars(Domain), scales = "free", space = "free") +
  scale_fill_manual(values = map_chr(palettes, 5))
#> Warning: Using alpha for a discrete variable is not advised.

​

​

更困难的方法是按域拆分数据并生成绘图列表，然后将它们与patchwork包放在一起。好处是您可以保留全彩色调色板，但缺点是更难控制从facet_grid获得的大小之类的东西，因为在某些领域中列出的问题比在其他领域中列出的问题要多。如果您认为这种方法是值得的，可以在plot_layout中手动调整它们的大小。您还需要调整一些主题元素来模仿facet_grid所做的事情。

plot_list <- df_full %>%
  split(.$Domain) %>%
  map2(palettes, function(domain_df, pal) {
    ggplot(domain_df, aes(x = RespondentLevel, y = Question_Code, fill = RespondentLevel)) +
      geom_tile() +
      theme_minimal() +
      scale_fill_manual(values = pal) +
      theme(legend.position = "none") +
      labs(x = NULL, y = NULL)
  })

reduce(plot_list, `+`) +
  plot_layout(ncol = 1)

​

​

请注意，通常情况下，patchwork会像plot1 + plot2一样将绘图放在一起，以模拟ggplot分层。因为我有一个列表中的图，所以我用purrr::reduce做了这件事。