之前有人问过这个问题,但由于没有reprex,所以没有得到答案,所以让我试一试。
假设我有两个跨越不同日期范围的数据集。我想使用滑块控制每个的可视化。以下表示将直接在下面创建视觉对象。
---
title: "Untitled"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
#+ message = FALSE, warning = FALSE
library(plotly)
library(crosstalk)
library(dplyr)
#+
```
```{r}
df1 <- data.frame(d = seq.Date(from = as.Date("2020-01-01"), by = "months", length.out = 100), v = runif(100))
df2 <- data.frame(d = seq.Date(from = as.Date("2020-6-01"), by = "months", length.out = 20), other_v = runif(20))
both_df <- full_join(df1, df2, by = 'd')
both_df_sh <- both_df %>% SharedData$new(group = "boom")
selector <- filter_slider(id = "selector1", label = "select dates", sharedData = both_df_sh, column = ~d)
v_p <- both_df_sh %>% plot_ly(x = ~d) %>% add_lines(y = ~v, name = "v", color = I("blue"))
other_v_p <- both_df_sh %>% plot_ly(x = ~d) %>% add_lines(y = ~other_v, name = "other v", color = I("red"))
```
```{r}
crosstalk::bscols(v_p, other_v_p)
```
这是正确的,因为两个图表都正确显示了它们的日期范围。但是,如果该范围内不存在数据,我的客户希望在图表中看到空白。像这样的东西:
---
title: "Untitled"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
#+ message = FALSE, warning = FALSE
library(plotly)
library(crosstalk)
library(dplyr)
#+
```
```{r}
df1 <- data.frame(d = seq.Date(from = as.Date("2020-01-01"), by = "months", length.out = 100), v = runif(100))
df2 <- data.frame(d = seq.Date(from = as.Date("2020-6-01"), by = "months", length.out = 20), other_v = runif(20))
both_df <- full_join(df1, df2, by = 'd')
both_df_sh <- both_df %>% SharedData$new(group = "boom")
selector <- filter_slider(id = "selector1", label = "select dates", sharedData = both_df_sh, column = ~d)
v_p <- both_df_sh %>% plot_ly(x = ~d) %>% add_lines(y = ~v, name = "v", color = I("blue")) %>%
layout(xaxis = list(range = list(min(both_df_sh$data()$d, na.rm = TRUE),
max(both_df_sh$data()$d, na.rm = TRUE))))
other_v_p <- both_df_sh %>% plot_ly(x = ~d) %>% add_lines(y = ~other_v, name = "other v", color = I("red")) %>%
layout(xaxis = list(range = list(min(both_df_sh$data()$d, na.rm = TRUE),
max(both_df_sh$data()$d, na.rm = TRUE))))
```
```{r}
selector
```
```{r}
crosstalk::bscols(v_p, other_v_p)
```
这就是我想要的!然而,现在,图表不再随 缩放filter_select
,它只是隐藏了数据,这并不能创造出可爱的视觉效果:
所以,我希望图表限制在拖动条时“跳过”......但要做到这一点,我需要当时的值filter_select
。
我想我可以通过改变这样的限制来事先得到它:
selector_values <- jsonlite::fromJSON(selector$children[[3]]$children[[1]])$values
v_p <- both_df_sh %>% plot_ly(x = ~d) %>% add_lines(y = ~v, name = "v", color = I("blue")) %>%
layout(xaxis = list(range = min(selector_values), max(selector_values)))
other_v_p <- both_df_sh %>% plot_ly(x = ~d) %>% add_lines(y = ~other_v, name = "other v", color = I("red")) %>%
layout(xaxis = list(range = min(selector_values), max(selector_values)))
但是这些值在仪表板启动后不会被重新评估。我需要一种方法来访问这些选择器的当前值......我该怎么做?