Question

我创建了一个包含ggplot2图表的闪亮应用，并希望在鼠标悬停时显示工具提示。我在此处找到了非常有用的信息：ToolTip when you mouseover a ggplot on shiny，以及它引用的来源：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点

1 个答案: