ggplot 悬停与旧式悬停相比，选择未按预期工作

Question

我正在尝试根据此处找到的代码为我的绘图构建悬停功能：解决方案 3 中的 SO 问题

悬停功能在 ggplot2 中已更改，但是当我更改时

plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),

自

plotOutput("distPlot", hoverOpts(id = "plot_hover", delay = 0),

悬停在一半的时间内不起作用(直到我单击某个地方。我在这里错过了什么吗？

还试图添加delayType论点，但似乎没有帮助。

library(shiny)
library(ggplot2)
ui <- fluidPage(
    tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
      padding: 0;
     }
  ')),
    tags$script('
    $(document).ready(function() {
      // id of the plot
      $("#distPlot").mousemove(function(e) { 
        // ID of uiOutput
        $("#my_tooltip").show();         
        $("#my_tooltip").css({             
          top: (e.pageY + 5) + "px",             
          left: (e.pageX + 5) + "px"         
        });     
      });     
    });
  '),
    selectInput("var_y", "Y-Axis", choices = names(iris)),
    plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0), ## issue is here
    uiOutput("my_tooltip")

)
server <- function(input, output) {

    output$distPlot <- renderPlot({
        req(input$var_y)
        ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
            geom_point()
    })
    output$my_tooltip <- renderUI({
        hover <- input$plot_hover 
        y <- nearPoints(iris, input$plot_hover)[input$var_y]
        req(nrow(y) != 0)
        wellPanel(dataTableOutput("vals"), style = 'background-color:#fff; padding:10px; width:400px;border-color:#339fff')
    })
    output$vals <- renderDataTable({
        hover <- input$plot_hover 
        y <- t(nearPoints(iris, input$plot_hover))
        req(nrow(y) != 0)
        DT::datatable(y, colnames = rep("", ncol(y)), options = list(dom = '', searching = F, bSort = FALSE))
    })  
}
shinyApp(ui = ui, server = server)

Answer 1

工作版本，修改自注释：

library(shiny)
library(ggplot2)
ui <- fluidPage(
  tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
      padding: 0;
     }
  ')),
  tags$script('
    $(document).ready(function() {
      // id of the plot
      $("#distPlot").mousemove(function(e) { 
        // ID of uiOutput
        $("#my_tooltip").show();         
        $("#my_tooltip").css({             
          top: (e.pageY + 5) + "px",             
          left: (e.pageX + 5) + "px"         
        });     
      });     
    });
  '),
  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = hoverOpts(id = "plot_hover", delay = 0)),
  uiOutput("my_tooltip")

)
server <- function(input, output) {

  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })
  output$my_tooltip <- renderUI({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)
    req(nrow(y) != 0)
    wellPanel(DT::dataTableOutput("vals"), style = 'background-color:#fff; padding:10px; width:400px;border-color:#339fff')
  })
  output$vals <- DT::renderDataTable({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)
    req(nrow(y)) != 0
    DT::datatable(t(y), colnames = rep("", ncol(t(y))), options = list(dom = 't', searching = F, bSort = FALSE))
  })  
}
shinyApp(ui = ui, server = server)