R Shiny中Highcharts散点图数据点与图例颜色不匹配问题求助

我尝试使用Highcharts绘制散点图，但是图中数据点的颜色与图例标签的颜色不一致。我需要颜色由名为"Check_color"的字段定义，因为该图表用于R Shiny应用中，有时图表不会展示所有可选分类，颜色需与"Rank"字段对应：即若筛选后仅展示"Yes"分类，所有点都应为绿色，仅展示"No"分类则所有点为红色，以此类推。当前图表中"Yes"分类的点为绿色，但对应的图例标签为蓝色，其余分类也存在相同的颜色不匹配问题。

原使用代码：

data = data.table(
  CJ(x = seq(as.Date("2019-01-01"), as.Date("2019-01-10"), by = "day"),
     group = seq(1,20))
)

data[, value := round(runif(n=200, 0,5),4)]
data = data.table(data %>% mutate(cat=cut(value, breaks=quantile(data[value!=0]$value, seq(0,1,0.1)), labels=seq(1,10))))

colf = colorRampPalette(colors = c("red","yellow", "green"))
cols = colf(10)

data[, color := as.factor(cols[cat])]
data$x = datetime_to_timestamp(data$x)
data = data.table(data %>% group_by(x) %>% mutate(y = (order(order(value))-sum(value<0,na.rm=T))))

data[, name := group]
data$x <- runif(200, 100, 1000) / 10
data$y <- runif(200, 100, 1000) / 10

data$gp_ <- round(runif(200,1,5), digits = 0)
data$Index <- seq(1,200,1)

data$Rank <- ifelse(data$gp_ == 1 , "Yes", ifelse(data$gp_ == 2 , "No",ifelse(data$gp_ == 3 , "Minor Deficiency",ifelse(data$gp_ == 4 , "Major Deficiency",ifelse(data$gp_ == 5 , "Not Applicable","")))))

data <- data[1:71,]


data$Check_color <- ifelse(data$Rank == "Yes" , "#14E632", ifelse(data$Rank == "No" , "#FA0101",ifelse(data$Rank == "Minor Deficiency" , "#FF99FF",ifelse(data$Rank == "Major Deficiency" , "#FF9933",ifelse(data$Rank == "Not Applicable" , "#CACECE","")))))

hc_1 <- data %>%
  hchart('scatter', hcaes(x = x, y = y , group = Rank, color = Check_color  )) %>% 
  hc_title(text = "<b>PUBLIC COMPANY D&O COVERAGE HEAT MAP  </b>") %>%
  hc_chart( 
    borderColor = "#999999",
    borderRadius = 20,
    borderWidth = 3) %>% 
  hc_tooltip(pointFormat = 'Provision ID:  {point.Index} <br/>
                            Provision:  {point.Check_color} <br/>
                            Severity:  {point.y:.2f} <br/>
                            Frequency:  {point.x:.2f} ')


hc_1

颜色不匹配的核心原因是：在hcaes中同时指定group = Rank和color = Check_color时，highcharter会自动为每个分组分配默认配色，逐点设置的颜色仅会作用于数据点，不会同步到图例项。
你可以通过显式绑定Rank与对应颜色的映射来解决问题，同时适配Shiny动态筛选的场景，修改后的完整代码如下：

library(data.table)
library(dplyr)
library(highcharter)

data = data.table(
  CJ(x = seq(as.Date("2019-01-01"), as.Date("2019-01-10"), by = "day"),
     group = seq(1,20))
)

data[, value := round(runif(n=200, 0,5),4)]
data = data.table(data %>% mutate(cat=cut(value, breaks=quantile(data[value!=0]$value, seq(0,1,0.1)), labels=seq(1,10))))

colf = colorRampPalette(colors = c("red","yellow", "green"))
cols = colf(10)

data[, color := as.factor(cols[cat])]
data$x = datetime_to_timestamp(data$x)
data = data.table(data %>% group_by(x) %>% mutate(y = (order(order(value))-sum(value<0,na.rm=T))))

data[, name := group]
data$x <- runif(200, 100, 1000) / 10
data$y <- runif(200, 100, 1000) / 10

data$gp_ <- round(runif(200,1,5), digits = 0)
data$Index <- seq(1,200,1)

# 定义固定的Rank-颜色映射，后续维护直接修改此处即可
rank_color_map <- c(
  "Yes" = "#14E632",
  "No" = "#FA0101",
  "Minor Deficiency" = "#FF99FF",
  "Major Deficiency" = "#FF9933",
  "Not Applicable" = "#CACECE"
)

# 生成Rank字段
data$Rank <- names(rank_color_map)[data$gp_]
data <- data[1:71,]

# 动态获取当前数据中存在的Rank对应的颜色，适配Shiny筛选场景
current_colors <- rank_color_map[unique(data$Rank)]

hc_1 <- data %>%
  hchart('scatter', hcaes(x = x, y = y, group = Rank)) %>% # 移除hcaes中的color参数
  hc_colors(current_colors) %>% # 显式绑定当前分类对应的颜色，同步图例和数据点
  hc_title(text = "<b>PUBLIC COMPANY D&O COVERAGE HEAT MAP  </b>") %>%
  hc_chart( 
    borderColor = "#999999",
    borderRadius = 20,
    borderWidth = 3) %>% 
  hc_tooltip(pointFormat = 'Provision ID:  {point.Index} <br/>
                            Provision:  {point.Check_color} <br/>
                            Severity:  {point.y:.2f} <br/>
                            Frequency:  {point.x:.2f} ')

hc_1

修改后无论Shiny筛选后剩下多少个Rank分类，图例和数据点的颜色都会和定义的映射完全一致。

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