hover/nearPoints() does not work correctly with position_stack geoms from ggplot2

[sgalletta213]

nearPoints() and the hover/click/etc arguments in plotOutput() do not work as expected for position_stack geoms in ggplot2 (such as geom_area). I would expect Shiny to treat the visual location of the area geoms as the correct hover location, but instead it looks at the geoms as though they all start at y = 0 and never stacked.

In this picture, I am hovering over the black circled point. I would expect this information to instead display when I hover over the top of the red area.

In the interest of not cluttering this post too much, I'll refer to my stackOverflow question with sample code and pictures. I was able to make a workaround, but it's a bit sketchy-looking, and the code would be confusing to another user with no context.

[cpsievert]

Thanks for writing in and linking to the SO post. In this example, and many others like #2411, ggplot2 has transformed the input data in some way, and brushedPoints()/ nearPoints() should be using that transformed data, but due to the current design, there is no nice workaround or straightforward fix. You could do a ggplot_build() hack and provide that transformed data into brushedPoints()/ nearPoints(), but in that case, mapping visual attributes (e.g., fill) back to the input data isn't necessarily straightforward:

library("shiny")
library("ggplot2")

d <- data.frame(date = as.Date(c("2017-01-01", "2017-01-02", "2017-01-03",
                                 "2017-01-01", "2017-01-02", "2017-01-03")),
                team = c("Celtics", "Celtics", "Celtics",
                         "Lakers", "Lakers", "Lakers"),
                points_scored = c(108, 89, 95, 78, 93, 82))

ui <- fluidPage(
  mainPanel(
    plotOutput("graph", 
               hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")),
    uiOutput("hover_info")
  )
)

server <- function(input, output) {

  my_plot <- reactive({
    ggplot(d, aes(x = date, y = points_scored, fill = team)) +
      geom_area()
  })

  output$graph <- renderPlot({
    my_plot()
  })

  output$hover_info <- renderUI({
    b <- ggplot_build(my_plot())
    point <- nearPoints(
      b$data[[1]], 
      input$plot_hover, 
      xvar = "x", yvar = "y",
      threshold = 5, 
      maxpoints = 1, 
      addDist = TRUE
    )
    if (nrow(point) == 0) return(NULL)

    wellPanel(
      paste0(point$x, ": ", point$y)
    )
  })
}

runApp(list(ui = ui, server = server))

Honestly, in this sort of scenario, you're probably better off using plotly::ggplotly() (at least for now). https://plotly-r.com/linking-views-with-shiny.html#shiny-plotly-inputs

library(plotly)

# add a column that helps us to map the hover data to the input data
d$id <- seq_len(nrow(d))

ui <- fluidPage(
  mainPanel(
    plotlyOutput("graph"),
    verbatimTextOutput("hover_info")
  )
)

server <- function(input, output) {

  my_plot <- reactive({
    ggplot(d, aes(x = date, y = points_scored, fill = team, customdata = id)) +
      geom_area()
  })

  output$graph <- renderPlotly({
    ggplotly(my_plot())
  })

  output$hover_info <- renderPrint({
    ed <- event_data("plotly_hover")
    d[d$id %in% ed$customdata, ]
  })
}

runApp(list(ui = ui, server = server))