如何根据串扰条件动态改变轴线 [英] how to dynamically change plotly axis based on crosstalk conditions

问题描述

此问题已been asked before，但没有得到答案，因为它没有表示，所以让我试一试。

假设我有两个跨越不同日期范围的数据集。我想使用滑块控制每个对象的可视化。以下表示将在正下方创建视觉效果。

---
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缩放，它只隐藏数据，这不会创建漂亮的视觉效果：

因此，当条形图被拖动时，我希望图表限制在&qootch；上(&p>)。但是要做到这一点，我需要当时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)))

但在仪表板启动后不会重新计算这些值。我需要一种方法来访问这些选择器的当前值..。我如何才能做到这一点？

推荐答案

我们可以使用Plot的matches参数来对齐多个地块的轴，就像我使用here一样：

---
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")) %>% layout(xaxis = list(matches = "x"))
```

```{r}
selector
```

```{r, out.width='100%'}
subplot(v_p, other_v_p, shareX = TRUE, shareY = TRUE)
```

---

原始答案：

我不确定我是否正确理解了您的预期输出，但是如果您想要自动缩放x轴，只需删除X轴range(layout()调用)。crosstalk将根据filter_slider：

提供过滤数据

---
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}
selector
```

```{r}
crosstalk::bscols(v_p, other_v_p)
```

使用共享x轴和距离滑块的无串扰方法：

library(plotly)
library(dplyr)

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')

fig1 <- plot_ly(both_df, x = ~ d, y = ~ v, type = "scatter", mode = "lines")
fig2 <- plot_ly(both_df, x = ~ d, y = ~ other_v, type = "scatter", mode = "lines") 

fig_shared_x <- subplot(fig1, fig2, nrows = 2, shareX = TRUE)
fig_shared_x

fig_rangeslider <- fig_shared_x %>% layout(xaxis = list(rangeslider = list(type = "date")))
fig_rangeslider

这篇关于如何根据串扰条件动态改变轴线的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！