Plotly Hover Events in Shiny

README.md

This is a demo of how to get plotly events back to shiny server.

Let us start by loading required libraries and preparing data. We use the ubiquitous mtcars dataset.

# Load Libraries ----
library(plotly)
library(shiny)
library(htmlwidgets)

# Prepare Data ---
mtcars$name = rownames(mtcars)

The UI for our shiny application is fairly simple. It consists of a plotly plot and a textOutput that displays some details of the point being hovered on.

ui <- fluidPage(
  plotlyOutput('myplot'),
  textOutput('hover')
)

The server requires more work. First, we need a modified version of renderPlotly, that is able to accept a htmlwidget as an argument. This is required since the renderPlotly function runs its arguments through an as.widget function that assumes that the expression has not been converted into a widget. This matters because we want to add ome post-render behavior to the widget.

renderPlotly2 <- function (expr, env = parent.frame(), quoted = FALSE){
  if (!quoted) {
    expr <- substitute(expr)
  }
  shinyRenderWidget(expr, plotlyOutput, env, quoted = TRUE)
}

The next thing to do is to write a javascript function that would define the behavior on hover. This function takes the same arguments as the renderValue function in htmlwidgets. It uses Shiny.onInputChange to pass data back to the shiny server. The idea is that input$hover_data now becomes available to the server.

addHoverBehavior <- "function(el, x){
  el.on('plotly_hover', function(data){
    var infotext = data.points.map(function(d){
      console.log(d)
      return (d.data.name[d.pointNumber]+': x= '+d.x+', y= '+d.y.toPrecision(3));
    });
    console.log(infotext)
    Shiny.onInputChange('hover_data', infotext)
  })
}"

Now, it is time to write our server function, and pass this hover behavior to the widget. The key here is the onRender function that allows you to inject post-render behavior to a widget. This function is in the github master of htmlwidgets and can be installed by running install_github("ramnathv/htmlwidgets"). So our server function becomes.

server <- function(input, output){
  output$hover <- renderText({
    input$hover_data
  })
  output$myplot <- renderPlotly2({
    p <- plot_ly(mtcars, x = mpg, y = wt, color = gear, name = name, mode = "markers")
    as.widget(p) %>% onRender(addHoverBehavior)
  })
}

Time to run the shiny app now

shinyApp(ui = ui, server = server)

code.R

# Load Libraries ----
library(plotly)
library(shiny)
library(htmlwidgets)

# Prepare Data ---
mtcars$name = rownames(mtcars)

ui <- fluidPage(
  plotlyOutput('myplot'),
  textOutput('hover')
)

renderPlotly2 <- function (expr, env = parent.frame(), quoted = FALSE){
  if (!quoted) {
    expr <- substitute(expr)
  }
  shinyRenderWidget(expr, plotlyOutput, env, quoted = TRUE)
}

addHoverBehavior <- "function(el, x){
  el.on('plotly_hover', function(data){
    var infotext = data.points.map(function(d){
      console.log(d)
      return (d.data.name[d.pointNumber]+': x= '+d.x+', y= '+d.y.toPrecision(3));
    });
    console.log(infotext)
    Shiny.onInputChange('hover_data', infotext)
  })
}"



server <- function(input, output){
  output$hover <- renderText({
    input$hover_data
  })
  output$myplot <- renderPlotly2({
    p <- plot_ly(mtcars, x = mpg, y = wt, color = gear, name = name, mode = "markers")
    as.widget(p) %>% onRender(addHoverBehavior)
  })
}


shinyApp(ui = ui, server = server)

I tried to reproduce your example but it fails though I use the latest version of htmlwidgets. I don't get an error message but an empty blank shiny viewer. Any idea? Maybe some dependencies not mentioned here accidentally?

I did this: plot_ly(mtcars, x =~mpg, y = ~wt, color = ~gear, name = ~name, mode = "markers")