rplotlyr-plotlycrosstalk

how to dynamically change plotly axis based on crosstalk conditions

This question has been asked before, but didn't get an answer since it didn't have a reprex, so let me give it a go.

Lets say I have two datasets that span different date ranges. I want to control the visualization of each using a slider. The following reprex will create the visual directly below.

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

enter image description here

This is correct since both charts show their date ranges correctly. However, my client would like to see blanks in charts if no data exists for that range. Something like this:

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

Which gives us, as expected, this: enter image description here

Which is what I wanted! However, now, the chart no longer scales with the filter_select, it only hides the data, which doesn't create lovely visuals: enter image description here

So, I would want the chart limit to "skootch over" as the bar is dragged... but to do that I need the value of the filter_select at the time.

I thought I could get it beforehand by changing the limits like this:

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

but those values don't get re-evaluated after the dashboard is launched. I need a way to access the CURRENT value of those selectors... how can I do that?

Solution

  • We can use plotly's matches parameter to align the axes of multiple plots just as I did 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)
```

    result

    Original answer:

    I'm not sure if I understand your expected output correctly but if you want to autoscale the x-axes just remove the xaxis range (the layout() call). crosstalk will take care about providing the filtered data based on the 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)
```

    result

    A non-crosstalk approach, using a shared x-axis and a rangeslider:

    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

    result