CODEWITHSUNDEEP
rshinyplotly
Noskario
Noskario

Reputation: 674

How do I check that plotly::event_data is actually caused by user interaction and not by another callback?

I want to create a shiny app with several plots that talk to each other.

Specifically lets say there are two plots p0 and p1 below each other and I want that they always keep the y-axis in sync. (Side note: I want to create several plots each with its own plot title, so plotly::subplot(..., shareY = TRUE) is not an option.)

See the following minimal example:

library(shiny)
library(plotly)

N <- 10
df <- data.frame(time = Sys.time() + seq_len(N), ind = seq_len(N), x0 = runif(N), x1 = 10 + runif(N))

ui <- fluidPage(
  plotlyOutput("p0"),
  plotlyOutput("p1"),
)

server <- function(input, output, session) {
  output$p0 <- renderPlotly({
    plot_ly(
      df,
      source = "p0",
      type = "scatter",
      mode = "markers",
      x=~time,
      y=~x0
    ) |> toWebGL()
  })
  output$p1 <- renderPlotly({
    plot_ly(
      df,
      source = "p1",
      type = "scatter",
      mode = "markers",
      x=~time,
      y=~x1
    ) |> toWebGL()
  })
  p0proxy <- plotlyProxy("p0", session = session)
  p1proxy <- plotlyProxy("p1", session = session)
  # last_event_data <- reactiveVal(NULL)
  observeEvent(event_data("plotly_relayout", source = "p0", priority = "event"), {
    ed <- event_data("plotly_relayout", source = "p0", priority = "event")
    # if (identical(ed, last_event_data())) {
    #   return()
    # }
    # last_event_data(ed)
    print(ed)
    plotlyProxyInvoke(p1proxy, "relayout", ed)
  })
  observeEvent(event_data("plotly_relayout", source = "p1", priority = "event"), {
    ed <- event_data("plotly_relayout", source = "p1", priority = "event")
    # if (identical(ed, last_event_data())) {
    #   return()
    # }
    # last_event_data(ed)
    print(ed)
    plotlyProxyInvoke(p0proxy, "relayout", ed)
  })
  
}

shinyApp(ui, server, options = list(launch.browser = TRUE))

This app does not work because e.g. user interaction in the y-axis of plot p0 causes the y-axis of p1 to update which triggers this same update again in p0 resulting in an infinite loop.

One way around it is to save the last user interaction in a reactiveVal last_event_data and ignore all inputs that are the same (uncomment the corresponding code in order to see it work).

This works but it feels like a hack to me: I want to listen especially to user interaction and if by chance the user makes the same interaction again it should trigger again. (In case of resetting the y-axis I guess it is fine: It is not possible to have the same interaction twice in a row (at least it seams to me), but if the event was clicking on a point or something else, then last_event_data is just the wrong approach.)

Do you have any thoughts on that?

Upvotes: 1

Views: 42

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33387

I'd suggest using shinys default behaviour instead of opting out via setting the parameter priority = "event".

By default shiny is lazy (to save resources) and will ignore repetitive reactives on its own. Regarding event_data this is the case when using priority = "input":

library(shiny)
library(plotly)

N <- 10
df <- data.frame(time = Sys.time() + seq_len(N), ind = seq_len(N), x0 = runif(N), x1 = 10 + runif(N))

ui <- fluidPage(
  plotlyOutput("p0"),
  plotlyOutput("p1"),
)

server <- function(input, output, session) {
  output$p0 <- renderPlotly({
    plot_ly(
      df,
      source = "p0",
      type = "scatter",
      mode = "lines",
      x=~time,
      y=~x0
    ) |> toWebGL()
  })
  output$p1 <- renderPlotly({
    plot_ly(
      df,
      source = "p1",
      type = "scatter",
      mode = "lines",
      x=~time,
      y=~x0
    ) |> toWebGL()
  })
  p0proxy <- plotlyProxy("p0", session = session)
  p1proxy <- plotlyProxy("p1", session = session)
  observeEvent(event_data("plotly_relayout", source = "p0", priority = "input"), {
    ed <- event_data("plotly_relayout", source = "p0", priority = "input")
    print(ed)
    plotlyProxyInvoke(p1proxy, "relayout", ed)
  })
  observeEvent(event_data("plotly_relayout", source = "p1", priority = "input"), {
    ed <- event_data("plotly_relayout", source = "p1", priority = "input")
    print(ed)
    plotlyProxyInvoke(p0proxy, "relayout", ed)
  })
}

shinyApp(ui, server, options = list(launch.browser = TRUE))

result

PS: Here the same approach can be found for plotly_restyle events.

Upvotes: 0

Related Questions