在R中为两个数据框应用crosstalk过滤器的问题求助

问题描述 #

开发抗菌药物使用情况交互式仪表盘，需实现两个可通过Antimicrobial Group和住院Location联动过滤的图表：

• 季度数据图表：基于quarterly数据框，按季度展示
• 月度数据图表：基于monthly数据框，按月度展示
  使用crosstalk的group功能尝试联动时，季度数据过滤正常，但月度数据的抗菌药物显示异常。

示例数据集 #

季度数据集

set.seed(123) # 固定随机数保证可复现
quarterly = data.frame(
  "Quarter" = rep(c("2022 Q4"), times = 6),
  "Entity" = rep(c("Hospital 1"), times = 6),
  "Location" = rep(c("Hem/Onc","Ward","ICU"), each = 2),
  "Antimicrobial_Group" = rep(c("Gram-Negative","Anti-MRSA"), times = 3), # 统一列名，替换空格为下划线
  "Agent" = c("aztreonam","ceftaroline","cefepime","dalbavancin","ceftazidime","linezolid"),
  "Rate" = sample(25:100, 6)
)

月度数据集

set.seed(123)
monthly = data.frame(
  "Month" = rep(c("2022-10-01","2022-11-01","2022-12-01"), times = 6),
  "Entity" = rep(c("Hospital 1"), times = 18), # 修正行数匹配Agent列长度
  "Location" = rep(c("Hem/Onc","Ward","ICU"), each = 6), # 对应Agent分组逻辑
  "Antimicrobial_Group" = rep(c("Gram-Negative","Anti-MRSA"), each = 9),
  "Agent" = c("aztreonam","cefepime","ceftazidime","aztreonam","cefepime","ceftazidime","aztreonam","cefepime","ceftazidime",
              "ceftaroline","dalbavancin","linezolid","ceftaroline","dalbavancin","linezolid","ceftaroline","dalbavancin","linezolid"),
  "Rate" = sample(1:25, 18, replace = TRUE) # 修正行数匹配Agent列长度
)

原代码问题分析 #

1. 两个过滤器使用相同id="abx"，导致DOM元素冲突，过滤逻辑混乱
2. 过滤器仅绑定到test_quarter，未关联test_month，无法同时作用于两个数据集
3. 月度数据的颜色映射基于原始数据的Agent数量，过滤后会出现颜色不匹配或缺失
4. 原月度数据的Entity和Location行数与Agent不匹配，数据结构错误

修正后的解决方案 #

核心要点 #

• 为每个过滤器设置唯一id，避免DOM冲突
• 两个SharedData实例归属同一group，实现联动
• 过滤器绑定到同组任意SharedData实例即可
• 颜色映射动态获取过滤后的Agent数量，保证匹配性

完整代码 #

library(crosstalk)
library(plotly)
library(RColorBrewer)

# 1. 创建修正后的示例数据集
set.seed(123)
quarterly = data.frame(
  "Quarter" = rep(c("2022 Q4"), times = 6),
  "Entity" = rep(c("Hospital 1"), times = 6),
  "Location" = rep(c("Hem/Onc","Ward","ICU"), each = 2),
  "Antimicrobial_Group" = rep(c("Gram-Negative","Anti-MRSA"), times = 3),
  "Agent" = c("aztreonam","ceftaroline","cefepime","dalbavancin","ceftazidime","linezolid"),
  "Rate" = sample(25:100, 6)
)

monthly = data.frame(
  "Month" = rep(c("2022-10-01","2022-11-01","2022-12-01"), times = 6),
  "Entity" = rep(c("Hospital 1"), times = 18),
  "Location" = rep(c("Hem/Onc","Ward","ICU"), each = 6),
  "Antimicrobial_Group" = rep(c("Gram-Negative","Anti-MRSA"), each = 9),
  "Agent" = c("aztreonam","cefepime","ceftazidime","aztreonam","cefepime","ceftazidime","aztreonam","cefepime","ceftazidime",
              "ceftaroline","dalbavancin","linezolid","ceftaroline","dalbavancin","linezolid","ceftaroline","dalbavancin","linezolid"),
  "Rate" = sample(1:25, 18, replace = TRUE)
)

# 2. 创建同组的SharedData实例
test_quarter <- SharedData$new(quarterly, group = "abx")
test_month <- SharedData$new(monthly, group = "abx")

# 3. 创建唯一id的过滤器
c1 <- filter_checkbox(
  id = "abx_group",
  sharedData = test_quarter,
  group = ~Antimicrobial_Group,
  label = "Select Antibiotic Group"
)

c2 <- filter_checkbox(
  id = "location",
  sharedData = test_quarter,
  group = ~Location,
  label = "Select Location"
)

# 4. 季度图表：动态设置颜色
p <- plot_ly(test_quarter, type = 'bar', x = ~Quarter, y = ~Rate, 
             color = ~Agent, 
             legendgroup = ~Agent,
             colors = brewer.pal(length(unique(test_quarter$data()$Agent)), "Paired")) %>%
  layout(title = 'Utilization Rates by Quarter and Filtered Antibiotic Group', 
         barmode = 'stack',
         xaxis = list(title = "", showline = TRUE),
         yaxis = list(side = 'left', ticks = "outside", 
                      title = 'Utilization Rate/1000 Patient-Days', 
                      showgrid = FALSE, zeroline = FALSE, showline = TRUE, rangemode = 'tozero'))

# 5. 月度图表：动态设置颜色+优化日期轴
p2 <- plot_ly(test_month, type = 'bar', x = ~as.Date(Month), y = ~Rate, 
              color = ~Agent, 
              legendgroup = ~Agent,
              colors = brewer.pal(length(unique(test_month$data()$Agent)), "Paired")) %>%
  layout(title = 'Utilization Rates by Month, Filtered Location, and Filtered Antibiotic Group', 
         barmode = 'stack',
         xaxis = list(title = "", showline = TRUE, type = "date", dtick = "M1",
                      tickformat = "%Y-%m"),
         yaxis = list(side = 'left', ticks = "outside", 
                      title = 'Utilization Rate/1000 Patient-Days', 
                      showgrid = FALSE, zeroline = FALSE, showline = TRUE, rangemode = 'tozero'))

# 6. 组合布局
bscols(widths = c(3, 4.5, 4.5),
       list(c1, c2), p, p2)

关键修正说明 #

• 过滤器唯一id：两个过滤器分别使用abx_group和location作为id，避免DOM元素冲突
• 同组联动：test_quarter和test_month归属同一group="abx"，过滤器选择会同步作用于两个数据集
• 动态颜色映射：通过test_quarter$data()$Agent获取过滤后的Agent列表，保证颜色数量与当前显示的Agent匹配
• 数据结构修复：修正月度数据的行数，确保各列长度一致
• 日期轴优化：将Month转为Date类型，设置tickformat优化日期显示效果

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