闪亮应用中鼠标悬停的工具提示不适用于 stat_summary 点

Question

我创建了一个包含 ggplot2 图表的闪亮应用程序，并希望在鼠标悬停时显示工具提示。我在这里找到了非常有用的信息：ToolTip when you mouseover a ggplot on shiny, as well as on the source it refers to: https://gitlab.com/snippets/16220.

虽然这对 geom_point 中显示的点非常有效，但它不适用于 stat_summary 添加的点。在我的具体情况下，我想使用 stat_summary 层来显示每月或每周的总计（基于闪亮应用程序中选择的输入）。

这是示例代码（geom_point 层不会出现在最终版本中，但在此处添加以表明工具提示对这些点有效）：

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)

感觉跟这部分有点关系:

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

因为它指的是 df（因此不是 stat_summary 的观点，但我不知道如何处理这个问题。

Answer 1

包 plotly 与 stat_summary 配合得很好。工具提示是开箱即用的绘图数据（本例中的 cyl 和 mpg）。

library(ggplot2)
library(plotly)

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

闪亮应用中鼠标悬停的工具提示不适用于 stat_summary 点

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

r

tooltip

ggplot2

shiny