Tooltip on mouseover in shiny app does not work on stat_summary points

Question

I created a shiny app containing a ggplot2 chart, and wanted to show tooltips on mouseover. I found very useful info here: ToolTip when you mouseover a ggplot on shiny, as well as on the source it refers to: https://gitlab.com/snippets/16220.

While this works perfectly well for the points that are shown in geom_point, it does not work for points added with stat_summary. In my specific case, I want to use a stat_summary layer to show monthly or weekly totals (based on the selected input in the shiny app).

This is the sample code (the geom_point layer would not be present in the final version, but is added here to show that the tooltips do work for those points):

library(shiny)    
library(ggplot2)

# Define UI for shiny app
ui <- pageWithSidebar(

  headerPanel("Plot"),
  sidebarPanel(
    selectInput("variable", "Period:", 
                c("Weekly" = "week",
                  "Monthly" = "month"))
  ),
  mainPanel(
    div(
      style = "position:relative",
      plotOutput("plot", 
                 hover = hoverOpts("plot_hover", delay = 100, 
                 delayType = "debounce")),
      uiOutput("hover_info")
    ),
    width = 7
  )
)

# Create Data set
x <- seq(as.Date("2017/1/1"), by = "day", length.out = 365)
y <- runif(365, 1, 100)
df <- data.frame(x,y)
df$month <- as.Date(cut(x, breaks = "month"))
df$week <- as.Date(cut(x, breaks = "week"))

# Define server logic
server <- function(input, output) {

  # Create the plot
  output$plot <- renderPlot({
      ggplot(data = df,
             aes_string(x = input$variable, y = "y")) +
      geom_point() +
      stat_summary(fun.y = sum,
                   geom = "point")
  })
  output$hover_info <- renderUI({
      hover <- input$plot_hover
      point <- nearPoints(df, hover, threshold = 5, 
               maxpoints = 1, addDist = TRUE)
      if (nrow(point) == 0) return(NULL)
      # calculate point position inside image
      left_pct <- (hover$x - hover$domain$left) / 
                  (hover$domain$right - hover$domain$left)
      top_pct <- (hover$domain$top - hover$y) / 
                 (hover$domain$top - hover$domain$bottom)
      # calculate distance from left and bottom side of the picture
      left_px <- hover$range$left + left_pct * 
                 (hover$range$right - hover$range$left)
      top_px <- hover$range$top + top_pct * 
                (hover$range$bottom - hover$range$top)
      # create style property for tooltip
      style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85); ", "left:", left_px + 2, "px; top:", top_px + 2, "px;")

      # actual tooltip created as wellPanel
      wellPanel(
          style = style,
          p(HTML(paste0("<b> Value: </b>", point$y, "<br/>",
                        "<b> Date: </b>", point$x, "<br/>")))
      )
  })
}

shinyApp(ui, server)

I have a feeling that it has something to do with this part:

point <- nearPoints(df, hover, threshold = 5, maxpoints = 1, addDist = TRUE)

because it refers to df (and hence not to the points from stat_summary, but I can't figure out how to deal with this.

Answer 1

The package plotly works quite well with stat_summary. Tooltips are provided out of the box from the plotting data (cyl and mpg in this example).

library(ggplot2)
library(plotly)

ggplotly(
  ggplot(mtcars, aes(cyl, mpg)) + geom_point() +
    stat_summary(fun.data = "mean_cl_boot", colour = "red", size = 2)
)