如何在ggplot中基于列名配置scale_fill_manual：指定列用自定义调色板

要实现指定列用自定义调色板、其余列用默认调色板的需求，核心是合并自定义颜色与默认调色板的颜色，让ggplot自动匹配对应列的颜色。具体步骤如下：

• 提取scale_fill_tq()的默认颜色，作为非指定列的配色
• 为目标列Sepal.Length.Sum设置自定义颜色，与默认颜色合并成命名向量
• 在ggplot中使用scale_fill_manual()传入合并后的颜色向量，无需分支判断

修改后的完整代码 #

# 1.0 Loading Libraries ----

#install.packages("reshape2")

# tidyverse contains: dplyr, ggplot2, tidyr, stringr, forcats, tibble, purrr, readr
library(tidyverse)

# shiny integrates user interface elements and reactivity
library(shiny)

# shinydashboard allows us to actually build the dashboard
library(shinydashboard)

# shinyWidgets offers custom widgets and other components to enhance your shiny applications.
library(shinyWidgets)

# tidyquant for financial analysis. Has nice ggplot2 themes
library(tidyquant)

# DT is used for making tables
library(DT)

library(reshape2)


# 2.0 Load Data ----

data <- iris


# 3.0 Cleaning Data ----

iris_summed <- data %>%
  group_by(Species) %>%
  summarize(Petal.Width.Sum = sum(Petal.Width),
            Petal.Length.Sum = sum(Petal.Length),
            Sepal.Width.Sum = sum(Sepal.Width),
            Sepal.Length.Sum = sum(Sepal.Length)) %>%
  ungroup() %>%
  reshape2::melt(measure.vars = c("Sepal.Length.Sum", "Sepal.Width.Sum", "Petal.Length.Sum", "Petal.Width.Sum"),
                 variable.name = "Characteristics") %>%
  mutate(value = value %>% as.numeric()) %>%
  rename(Numerical = value)

# 定义自定义颜色：Sepal.Length.Sum对应每个物种的颜色
custom_colors <- c(
  "Sepal.Length.Sum_setosa" = "#33CCCC",
  "Sepal.Length.Sum_versicolor" = "#00A499",
  "Sepal.Length.Sum_virginica" = "#CC0000" # 修正原代码颜色值的拼写错误
)

# 提取scale_fill_tq的默认颜色
default_tq_colors <- scales::hue_pal()(length(unique(iris_summed$Characteristics)))
names(default_tq_colors) <- unique(iris_summed$Characteristics)


# 4.0 Shiny User Interface ----

ui <- dashboardPage(title = "Iris Data Evaulation", skin = "blue",
                    
                    dashboardHeader(title = "Iris Dashboard"),
                    
                    dashboardSidebar(
                      sidebarMenu(
                        sidebarSearchForm("searchtext", "buttonSearch", "Search"),
                        menuItem("Iris Dataset",
                                 tabName = "iris_dataset",
                                 icon = icon("fas fa-chart-bar"))
                      )
                    ),
                    
                    dashboardBody(
                      tabItems(
                        tabItem(tabName = "iris_dataset",
                                fluidRow(box(width = 3,
                                             height = 400,
                                             selectInput(inputId = "iris_id",
                                                         label = h5(strong("Iris Information")),
                                                         choices = unique(data$Species),
                                                         selected = "")),
                                         box(width = 9,
                                             height = 400,
                                             h5(strong("Iris Breakdown")),
                                             DT::dataTableOutput("iris_table"), 
                                             style = "height:400px; overflow-y: scroll"),
                                         box(width = 12,
                                             height = 400,
                                             title = "Iris Chart",
                                             status = "primary",
                                             solidHeader = T,
                                             plotOutput("iris_chart"))
                                         
                                         
                                ))))) 



# 5.0 Shiny Server ----

server <- function(input, output, session) {
  
  iris_tbl <- reactive({
    data %>%
      filter(Species %in% input$iris_id)
  })
  
  output$iris_table <- DT::renderDataTable({
    iris_tbl()},
    rownames = FALSE,
    extensions = "FixedHeader",
    options = list(
      scrollX = TRUE,
      scrollY = "450px",
      autoWidth = TRUE,
      fixedHeader = TRUE,
      pageLength = 10,
      lengthMenu = c(10, 15),
      dom = "pt"
    ))
  
  iris_filter <- reactive({
    iris_summed %>%
      filter(Species %in% input$iris_id)
  })
  
  output$iris_chart <- renderPlot({
    # 创建用于匹配颜色的组合键：Characteristics_Species
    plot_data <- iris_filter() %>%
      mutate(color_key = paste(Characteristics, Species, sep = "_"))
    
    # 合并自定义颜色与默认颜色：优先使用自定义颜色
    combined_colors <- c(default_tq_colors, custom_colors)
    
    actual_plot <- plot_data %>%
      ggplot(aes(Species, Numerical, fill = color_key)) +
      geom_col(width = 0.5) +
      scale_fill_manual(values = combined_colors,
                        # 恢复图例显示为原Characteristics名称
                        labels = function(x) str_remove(x, "_.*$")) +
      theme_tq()+
      labs(
        title = "Characteristics Per Iris Species",
        x = "Iris Species",
        y = "Iris Characteristics",
        fill = "Characteristics"
      )
    
    actual_plot
  })
  
}

# 6.0 Connecting UI with Server ----

shinyApp(ui, server)

关键修改说明 #

1. 修正颜色值拼写错误：原代码中"#CC000"少一位，改为"#CC0000"
2. 创建颜色匹配键：通过Characteristics_Species的组合键，精准匹配指定列对应物种的自定义颜色
3. 合并颜色向量：将自定义颜色与scale_fill_tq()的默认颜色合并，ggplot会自动优先匹配自定义颜色，未匹配到的使用默认色
4. 简化逻辑：去掉原代码中错误的分支判断，统一处理所有情况，避免因dataframe判断导致的逻辑错误

内容的提问来源于stack exchange，提问作者Harry Kalsted