r - 我的 'recent' 线被隐藏，图表没有恢复到原始状态。这是 bscol 的错误吗？

Question

我正在尝试使用串扰(特别是使用 filter_checkbox 和 filter_select)向我的绘图图表添加一些交互性，但我遇到了一些障碍。我首先通过 ggplot 生成绘图，然后使用 ggplot 函数将其转换为 plotly。

虽然我可以很好地生成图表(并且在 Markdown 上有很多交互性)，但我有几个问题。首先，当我希望过滤时(通过 filter_select 或 filter_checkbox)，“最近”的数据完全从图表中消失，并且不刷新 html 就无法恢复。我正在过滤的实际数据也会发生类似的事情；如果不刷新页面，我无法将图表恢复到原始状态。

有人知道这是为什么吗？下面是我的代码 + 数据的副本。

下面是我的数据片段(data=historic):

structure(list(date = c("23-03-2019", "23-03-2019", "23-03-2019", 
"23-03-2019", "05-05-2020", "05-05-2020", "05-05-2020", "05-05-2020", 
"17-06-2021", "17-06-2021", "17-06-2021", "17-06-2021"), cumvol = c(0.004, 
0.034, 0.054, 0.057, 0.005, 0.048, 0.068, 0.075, 2.009, 2.029, 
2.049, 2.064), time = structure(c(26457, 26636, 26658, 27216, 
25152, 25614, 25667, 25668, 56966, 57268, 57303, 58986), units = "secs", class = c("hms", 
"difftime")), Year = c("2019", "2019", "2019", "2019", "2020", 
"2020", "2020", "2020", "2021", "2021", "2021", "2021"))

在此之上，我从一个单独的 df (data=recent) 中绘制了另一条线。

structure(list(date = structure(c(19038, 19038, 19038, 19038), class = "Date"), 
cumvol = c(0.029, 0.034, 0.07, 0.075), time = structure(c(29674, 29674, 29691, 29719), 
class = c("hms", "difftime"), units = "secs")), Year = c("2022", "2022", "2022", "2022"))

然后我将数据转换为共享数据，使用该数据创建一个 ggplot，然后将该图转换为 ggplot，如下所示(变量“most_recent”指的是“最近”数据框中的最新条目，由最近生成[nrow(最近),]:

sharedhistoric <- SharedData$new(historic, key = ~Date)
sharedrecent <- SharedData$new(recent, key = ~Date)

plot <- ggplot()+geom_line(data=sharedhistoric,aes(x=time, y=cumvol, group=date),color='#BAB0AC', alpha=0.5)+
      geom_line(data=sharedrecent ,aes(x=time, y=cumvol, group=date),size=1.2,color='#E15758')+
      geom_point(data=most_recent, aes(x=time,y=cumvol), color='#E15759',size=3)+geom_hline(yintercept = 0)+  theme(title=element_text(size=12),panel.background = element_rect(fill='white',color='black'),legend.position='right')+
        labs(title = "Vol",subtitle = "Cum Vol so far", x = "Time", y = "Vol")

最后，我将图表转换为 plotly 并使用以下 bcols:

chartyplot <- plotly::ggplotly(plot)
bscols(widths = c(4, 9),
       list(
         crosstalk::filter_checkbox("Year", 
                         label = "Select Year",
                       sharedhistoric, 
                        group = ~Year),
         crosstalk::filter_select("Date", 
                       label = "Date",
                      sharedhistoric, 
                       group = ~Date)
         ), chartyplot)

感谢您的任何帮助/建议。

Answer 1

据我所知，有两种影响导致了这种行为

1. SharedData 对象的(非)唯一键
2. 任何未从 crosstalk::filter_* 中选择的内容都将从绘图中删除

TL;DR:实现此目的的方法是确保唯一键，并将不同的数据集分配给同一组。一旦应用任何过滤器，任何不 SharedData 对象的数据都会丢失。我们可以通过 HTML 标签修​​复一些数据来欺骗一些数据以始终保留在绘图上。

1 键

查看 crosstalk 的按键部分 documentation ，键在数据集中应该是唯一的。因此，在给定的数据集中，date 可能不是一个好的选择。相反，我们可以简单地根据行号创建键(这也是没有提供键时的默认行为)

sharedhistoric <- SharedData$new(historic %>% mutate(key = as.character(row_number())), key = ~key)
sharedrecent <- SharedData$new(recent %>% mutate(key = as.character(row_number())), key = ~key)

...但现在仅显示“最新”数据(对于 2019 年，应选择“历史”数据的第 1-4 行)(左图)。切换 geom_line 语句的顺序(首先是“最近”，然后是“历史”)导致“历史”数据的正确行为，但“最近”消失了(右图)。这实质上意味着，过滤后的键仅应用于添加到 ggplot 的最后一个 SharedData 对象。

交互使用这两个数据集的下一步是将它们分配到同一组，每个文档可用于链接多个数据集实例。

sharedhistoric <- SharedData$new(..., key = ~key, group = "mydata")
sharedrecent <- SharedData$new(..., key = ~key, group = "mydata")

这看起来已经更好了，我们不断过滤和恢复“历史”和“最近”数据 - 但 2019 年现在与两个数据集的前 4 行相关联(因为重复键):

一个可能的解决方法是全局定义唯一键并将子数据集分配给同一组:

historic <- as.data.frame(historic) %>%
  dplyr::mutate(date = as.character(date), 
                set = "historic")
recent <- as.data.frame(recent) %>%
  dplyr::mutate(date = as.character(date), 
                set = "recent")
all <- bind_rows(historic, recent) %>%
  dplyr::mutate(key = as.character(row_number()))

sharedall <- SharedData$new(all, key = ~key, group = "mydata")
sharedhistoric <- SharedData$new(all %>% dplyr::filter(set == "historic"), key = ~key, group = "mydata")
sharedrecent <- SharedData$new(all %>% dplyr::filter(set == "recent"), key = ~key, group = "mydata")

#--- no changes to the plot ---
# but choose filter options from full dataset

bscols(widths = c(4, 8),
       list(
         crosstalk::filter_checkbox("id_year", 
                                    label = "Select Year",
                                    sharedall, 
                                    group = ~Year),
         crosstalk::filter_select("id_date", 
                                  label = "Date",
                                  sharedall, 
                                  group = ~date)
       ),
       chartyplot)

现在我们可以正确(取消)选择历史和最近的数据。

2个“丢失”的数据点

如果前面的示例仅基于“历史”数据使用过滤器选择，那么在选择第一个过滤器后，“最近”数据(来自不同年份)似乎无法恢复。与“most_recent”数据点类似，它不是 SharedData 对象。此数据点最初绘制，但在设置第一个过滤器后立即删除。

但是，这可以通过定义属于同一组的“最新”SharedData 对象以相同的方式解决:

sharedmostrecent <- SharedData$new(all %>% tail(1), key = ~key, group = "mydata")

#plot adjustment
...
geom_line(...) +
geom_point(data=sharedmostrecent, aes(x=time,y=cumvol), color='#E15759',size=3) +
...

有了这个，我们可以选择和取消选择图中的所有数据，而不会丢失任何数据。

3 修复一些数据

为了确保“最近的”数据无论(手动过滤器值)如何，我们都可以操纵 HTML 输出。首先，我们通过不按年份过滤来分离数据集，而是按最近/历史和年份(或任何其他合适的数据子集)过滤:

all <- bind_rows(historic, recent) %>%
  dplyr::mutate(key = as.character(row_number()),
                dataset = paste0(set, " ", Year))
...
out <- bscols(widths = c(4, 8),
       list(
         crosstalk::filter_checkbox("id_year", 
                                    label = "Select dataset",
                                    sharedall, 
                                    group = ~dataset)
       ),
       chartyplot) 

然后我们检查并禁用我们最近的数据集的复选框 - 这可能会更优雅地完成，但它在我的 Rmd 中有效:

library(htmltools)
out_tags <- htmltools::renderTags(out)
out_tags$html <- stringr::str_replace(
  out_tags$html, 
  '<input type="checkbox" name="id_year" value="recent 2022"/>',
  '<input type="checkbox" name="id_year" value="recent 2022" disabled="disabled" checked="checked"/>'
  )
out_tags$html <- HTML(out_tags$html)
as.tags(out_tags)