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进行了此操作。

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

1 个答案: