悬停时显示与散点图关联的标签

Question

我正在尝试制作一个应用程序，该应用程序显示与悬停在散点图上的最近点（在绘制区域上，而不是下方，如果可能）相关联的标签。我一直无法在网上找到准确的例子，如果这个问题已经在某些地方得到解决，我深表歉意。

这是我目前所拥有的：

df <- data.frame(x = rnorm(100), y = rnorm(100), label = paste("gene", seq(100)))

ui <- fluidPage(
  plotOutput(outputId = "scatterplot", hover = "plot_hover"),
  verbatimTextOutput("info")
)


server <- function(input, output) {
  
    output$scatterplot <-
      renderPlot({
        ggplot(df, aes(x, y)) +
          geom_point()
      })
  
    output$info <- renderPrint({
      row <- nearPoints(df, input$plot_hover, threshold = 5, maxpoints = 1)
      cat("Testing:\n")
      print(row$label)
    })
}
                 

shinyApp(ui, server)
                

我应该说：我对 RShiny 很陌生。

Answer 1

这是一个例子：

library(shiny)
library(ggplot2)

dat <- data.frame(x = rnorm(10), y = rnorm(10), label = LETTERS[1:10])

ui <- basicPage(
  div(
    style = "position:relative",
    plotOutput("ggplot", hover = hoverOpts("plot_hover")),
    uiOutput("hoverinfo")
  )
)

server <- function(input, output){
  output$ggplot <- renderPlot(
    ggplot(dat, aes(x=x, y=y)) + geom_point()
  )
  
  output$hoverinfo <- renderUI({ 
    hover <- input[["plot_hover"]]
    if(is.null(hover)) return(NULL)
    
    point <- nearPoints(dat, hover, threshold = 5, maxpoints = 1)
    if(nrow(point) == 0) return(NULL)
    
    left_px <- hover$coords_css$x
    top_px  <- hover$coords_css$y
    
    style <- paste0(
      "position:absolute; z-index:100; pointer-events:none; ", 
      "background-color: rgba(245, 245, 245, 0.85); ",
      "left:", left_px, 
      "px; top:", top_px, "px;"
    )
    
    # tooltip created as wellPanel
    tooltip <- paste0(
      "<b> x: </b>",     point[["x"]],     "<br/>",
      "<b> y: </b>",     point[["y"]],     "<br/>",
      "<b> label: </b>", point[["label"]], "<br/>"
    )
    wellPanel(
      style = style, p(HTML(tooltip))
    )
  }) 
  
}

shinyApp(ui, server)