含dichromat_pal滤镜的Shiny App无法正常运行

问题背景 #

开发了一款可切换「原始版/优化版」图表的Shiny App，计划通过dichromat包模拟色盲视觉效果，但选择色盲类型时触发以下错误：

Warning: Error in : 'dichromat_pal' is not an exported object from 'namespace:dichromat'

已尝试重装包、重启R，问题仍存在。

错误原因 #

dichromat包没有导出dichromat_pal函数，该函数名是误用。正确的用法是使用dichromat()函数，传入原始颜色向量和目标色盲类型，直接转换颜色。

修复方案 #

核心修改点 #

1. 移除对dichromat_pal的调用，改用dichromat()转换原始颜色
2. 拆分原始图表和优化图表的颜色向量，分别进行色盲转换
3. 将日期转换逻辑抽离为反应式数据，避免重复计算

修复后完整代码 #

library(shiny)
library(dichromat)
library(ggplot2)

# 定义原始图表和优化图表的颜色向量
original_colors <- c(
  "#6EAA75", "#C9C9C9", "#000000", "#5B5B5B", "#FFC6FF",
  "#AD8BC9", "#619CFF", "#F9A26C", "#FF6161", "#FFBE61"
)
improved_colors <- c(
  "#2c7bb6", "#2c7bb6", "#2c7bb6", "#abd9e9", "#abd9e9",
  "#abd9e9", "#d7191c", "#fdae61", "#fdae61", "#fdae61"
)

# UI定义
ui <- fluidPage(
  titlePanel("Graphic Optimization"),
  fluidRow(
    column(
      3,
      selectInput(
        "image_name", "Image:",
        c("Original" = "original", "Improved" = "improved")
      ),
      selectInput(
        "color_blind_type", "Type of ColorBlindness:",
        c("Normal", "Deutan", "Protan", "Tritan")
      )
    ),
    mainPanel(plotOutput("plot"))
  )
)

# Server定义
server <- function(input, output) {
  # 预处理数据：转换日期，避免重复计算
  processed_data <- reactive({
    data <- read.csv("badgraph.csv")
    data$Mth.Yr <- as.Date(paste(data$Mth.Yr, "-01", sep = ""))
    data
  })
  
  # 获取转换后的色盲友好颜色
  get_filtered_colors <- reactive({
    base_colors <- if(input$image_name == "original") original_colors else improved_colors
    
    switch(input$color_blind_type,
           "Normal" = base_colors,
           "Deutan" = dichromat(base_colors, type = "deutan"),
           "Protan" = dichromat(base_colors, type = "protan"),
           "Tritan" = dichromat(base_colors, type = "tritan")
    )
  })
  
  # 渲染图表
  output$plot <- renderPlot({
    data <- processed_data()
    colors <- get_filtered_colors()
    
    if(input$image_name == "original") {
      ggplot(data, aes(x = Mth.Yr, y = Rate, group = Race.Sex, color = Race.Sex)) +
        geom_line(size = 1) +
        scale_color_manual(values = colors) +
        labs(
          x = "Month/Year", y = "Unemployment Rate",
          title = "Unemployment Rates by Race and Sex",
          subtitle = "Groups not defined as 16-19, are all adults 20+"
        ) +
        scale_x_date(date_breaks = "1 month") +
        theme_bw() +
        theme(
          plot.title = element_text(hjust = 0.5),
          plot.subtitle = element_text(hjust = 0.5),
          legend.key.size = unit(0.5, "lines"),
          legend.text = element_text(size = 7),
          axis.text.x = element_text(angle = 45, size = 7, hjust = 1)
        )
    } else {
      ggplot(data, aes(x = Mth.Yr, y = Rate, group = Race.Sex, 
                       color = Race.Sex, linetype = Race.Sex)) +
        geom_line(aes(size = Race.Sex)) +
        scale_size_manual(values = c(1, 1.25, 1, 1, 1.25, 1, 2, 1, 1.25, 1)) +
        scale_color_manual(values = colors) +
        scale_linetype_manual(
          values = c("solid", "dotdash", "dashed", "solid", "dotdash", "dashed",
                     "solid", "solid", "dotdash", "dashed")
        ) +
        labs(
          x = "Month/Year", y = "Unemployment Rate",
          title = "Unemployment Rates by Race and Sex",
          subtitle = "Groups not defined as 16-19, are all adults 20+"
        ) +
        scale_x_date(date_breaks = "1 month") +
        theme_bw() +
        theme(
          plot.title = element_text(hjust = 0.5),
          plot.subtitle = element_text(hjust = 0.5),
          legend.key.size = unit(0.5, "lines"),
          legend.text = element_text(size = 7),
          axis.text.x = element_text(angle = 45, size = 7, hjust = 1)
        )
    }
  })
}

# 运行App
shinyApp(ui = ui, server = server)

额外说明 #

• 原代码中filtered_plot输出未使用，已移除UI中的对应部分
• 将日期转换放在processed_data反应式中，避免每次渲染图表都重复转换
• 分离了原始/优化图表的颜色向量，确保色盲转换对应正确的基础颜色

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