使用纯 ggplot2 解决方案在 Shiny 中悬停工具提示

Question

此处的目标是使用纯 ggplot2 解决方案在悬停时呈现工具提示，而无需任何 javascript 黑客攻击。

这是一个天真的尝试性解决方案（不起作用）

library(tidyverse)
library(shiny)
shinyApp( 
  ui = fluidPage( 
    plotOutput("plotCars", hover="hover", width=700,height=300), 
    verbatimTextOutput("info")), 
  
  server = function(input, output) {
    hovered <- reactive(nearPoints(mtcars, input$hover, maxpoints = 1) %>%
                           rownames_to_column("model"))

    output$plotCars <- renderPlot({ 
      ggplot(mtcars, aes(x=wt, y=mpg)) + 
      geom_point() +
      geom_point(color="red",data=hovered()) +
      geom_label(aes(label=model),data=hovered(),
                 hjust="inward",vjust="inward",
                 size=4,color="red",alpha=0.5)+
      xlab("Weight(1000 lbs)")+ylab("Miles/gallon")
    })
    
    output$info <- renderPrint({
      hovered()
    })
})

这里的问题是，一旦重新渲染绘图，包括悬停信息（例如标签），悬停事件就会自动重置为 NULL，从而使绘图无效。

在实践中，上述解决方案几乎有效，悬停点的工具提示会短暂显示，但 input$hover 事件立即被新情节和绘图的重新渲染删除了工具提示，因为悬停事件现在是 NULL。事实上工具提示闪烁一次然后消失。

Answer 1

解决方法是保留悬停数据点的前一个值，避免失效。这个objective可以使用observeEvent() method and a reactiveVal()来实现。解决方案是这样的：

悬停点信息是一个反应值 (reactiveVal())，用 zero-row tibble 初始化，与绘制的数据集具有相同的列。这个初始值允许在 ggplot2 层中进行平滑的可视化，将它初始化为 NULL.
是不可能的
该值响应悬停事件而更新，当事件变为NULL时函数observeEvent()默认忽略（ignoreNULL = TRUE)，因此当 input$hover 无效为 NULL 时，该值不会更新并保持与之前相同
在绘图渲染中，hovered() 值最初是一个 zero-row tibble（但仍然具有与绘图默认数据兼容的正确列）因此不显示任何东西，稍后当在一个点附近执行悬停时，它将包含点信息。

library(tidyverse)
library(shiny)
shinyApp( 
  ui = fluidPage( 
    plotOutput("plotCars", hover="hover", width=700,height=300), 
    verbatimTextOutput("info")), 
  
  server = function(input, output) {
    hovered <- reactiveVal(mtcars %>% filter(FALSE) %>% rownames_to_column("model"))
    observeEvent(input$hover, {
                 hovered(nearPoints(mtcars, input$hover, maxpoints = 1) %>%
                           rownames_to_column("model"))
    })
    
    output$plotCars <- renderPlot({ 
      ggplot(mtcars, aes(x=wt, y=mpg)) + 
      geom_point() +
      geom_point(color="red",data=hovered()) +
      geom_label(aes(label=model),data=hovered(),
                 hjust="inward",vjust="inward",
                 size=4,color="red",alpha=0.5)+
        xlab("Weight(1000 lbs)")+ylab("Miles/gallon")
    })
    
    output$info <- renderPrint({
      hovered()
    })
  })

使用纯 ggplot2 解决方案在 Shiny 中悬停工具提示

Hover tooltip in Shiny using pure ggplot2 solution

r

ggplot2

shiny