ggplotly with plotlyproxy in shiny app

[nurfatimaj]

Hi! I am trying to make an interactive plot such that a single line gets highlighted with colour on click (or hover, but currently this results in million plot reloads). Below is the example of what I am currently doing.

Sample data:

data <- data.frame(country = rep(c('A', 'B'), each = 12*4), 
                   region = rep(c(1, 2, 3, 4), each = 12, times = 2), 
                   week = rep(seq(1, 12, 1), times = 2*4), 
                   value = rnorm(n = 12*4*2))
data <- data %>% mutate(region = paste0(country, region))

ui

ui <- fluidPage(plotlyOutput('lineplot'))

server

server <- function(input, output, session) {
  output$lineplot <- renderPlotly({
    p <- ggplot(data = data, 
                aes(x = week, 
                    y = value, 
                    group = region, 
                    customdata = region)) + 
      geom_line(colour = 'lightgray') + 
      facet_wrap(~ country, scales = 'free_y') + 
      theme_bw()
    
    click <- event_data('plotly_click')
    
    if (!is.null(click)) {
      selected <- data %>% filter(region == click$customdata)
      p <- p + geom_line(data = selected, aes(colour = region))
    }
    
    ggplotly(p, tooltip = 'group')
  })
}

However, this is a little bit slow since if I understand correctly the whole plot gets rerendered on click. For the same reason hover was resulting in million reloads and therefore was VERY slow.

I came across references to some examples that use observe and plotlyProxy (here), but I couldn't get it working with the plot that has facets. Following the example to letter, I only ever managed to add lines to the first panel even though the clicked line belongs to the second panel.

I am new to shiny and ggplotly and plotly, and only just getting the logic of things. But I cannot understand what should I do to I achieve my goal.

Any help is appreciated!

Thanks!

[cpsievert]

Let me start by 1st mentioning that this sort of linked highlighting can be done client-side (i.e., without shiny) via highlight_key() and highlight(). You can read more about how that works here 16 Client-side linking | Interactive web-based data visualization with R, plotly, and shiny

p2 <- ggplot(data = highlight_key(data, ~region), 
       aes(x = week, y = value, group = region)) + 
  geom_line(colour = 'lightgray') + 
  facet_wrap(~ country, scales = 'free_y') + 
  theme_bw()

highlight(ggplotly(p2), color = "red")

You can also embed this result in a shiny app, but for sake of completeness and learning, I'll go through how this could also be done (performantly) in shiny. Note that when you use plotlyProxy() to modify a plotly graph, you need to think on the plotly.js level. In other words, you need to have some understanding how the figure is represented as JSON. plotly_json() is helpful for that:

plotly_json(p)

The most important piece of the figure object is data. Here we have 2 "traces" of data, one for each panel. If you wanted, you could use plotlyProxyInvoke() to "restyle" (that is, modify) those traces, but in this case, it'll be much easier to leverage "addTraces". Moreover, for this example, it makes sense to leverage plotly_build(), which is like plotly_json(), but gives you the figure representation as an R list (instead of JSON). The return object is an htmlwidgets object, but you can get at the underlying plotly.js object in plotly_build(p)$x, and thus, the underlying traces with plotly_build(p)$x$data:

server <- function(input, output, session) {
  
  my_plot <- function(data, colour = 'lightgray') {
    ggplot(data, aes(x = week, y = value, group = region, customdata = region)) + 
      geom_line(colour = colour) + 
      facet_wrap(~ country, scales = 'free_y') + 
      theme_bw()
  }
  
  output$lineplot <- renderPlotly({
    # redraw on double-click it...this _could_ be made more performant with 
    # plotlyProxyInvoke("deleteTraces", ...), but it'd also be more complicated
    event_data("plotly_doubleclick")
    my_plot(data)
  })
  
  observeEvent(event_data('plotly_click'), {
    click <- event_data('plotly_click')
    gg <- my_plot(
      filter(data, region %in% click$customdata),
      colour = "red"
    )
    plotlyProxy("lineplot", session) %>%
      plotlyProxyInvoke("addTraces", plotly_build(gg)$x$data)
  })
  
}

[julianstanley]

Carson's answer is killer, as you'd expect .

Just peeking in to recommend Adam Loy's datacamp course ("Intermediate Interactive Data Visualization with plotly in R"), if you're interested, which covers the basics of highlighting/interactivity in plotly: https://learn.datacamp.com/courses/intermediate-interactive-data-visualization-with-plotly-in-r

[nurfatimaj]

Thanks a lot! Really!