如何在ggplot2中悬停时在工具提示中显示y值

Question

当我将鼠标放在图表中的一个点上时,我希望显示y值.我的情节代码如下:

output$graph <- renderPlot({
  p1 <- ggplot(data, aes(x= date)) + 
  geom_line(aes(y=Height, colour = "Height"), size=1) + 
  geom_point(aes(y=Height, colour = "Height", text = paste("Weight/Height:", Height)))
  plot(p1)
})

我做了一些研究,我认为这text = paste("Weight/Height:", Height)部分aes将确保文本出现.很遗憾没有出现.有谁知道我做错了什么？

Answer 1

不幸的ggplot是,它不是交互式的,但它可以很容易地"修复" plotly包.您只需要替换plotOutput,plotlyOutput然后渲染绘图renderPlotly.

例1:情节

library(shiny)
library(ggplot2)
library(plotly)

ui <- fluidPage(
    plotlyOutput("distPlot")
)

server <- function(input, output) {
   output$distPlot <- renderPlotly({
      ggplot(iris, aes(Sepal.Width, Petal.Width)) + 
       geom_line() + 
       geom_point()
   })
}

shinyApp(ui = ui, server = server)

示例2:plotOutput(...,hover ="plot_hover"):

我们不必使用任何特殊包来向我们的图表引入交互性.我们所需要的只是我们可爱的闪亮shiny!plotOutput例如click,我们可以使用选项,hover或者dblclick使绘图具有交互性.(查看闪亮图库中的更多示例)

在下面的示例中,我们添加"悬停" hover = "plot_hover",然后指定延迟,默认为300毫秒.

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

然后我们可以通过访问值input$plot_hover并使用函数nearPoints来显示点附近的值.

ui <- fluidPage(
  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
  uiOutput("dynamic")

)

server <- function(input, output) {

  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })

  output$dynamic <- renderUI({
    req(input$plot_hover) 
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    # print(str(hover)) # list
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })

}
shinyApp(ui = ui, server = server)

示例3:自定义ggplot2工具提示:

第二种解决方案效果很好,但是......我们希望做得更好!是的......我们可以做得更好!(...如果我们使用一些javaScript但是pssssss不告诉任何人!).

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),
  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)
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })  
}
shinyApp(ui = ui, server = server)

示例4:ggvis和add_tooltip:

我们也可以使用ggvis包.这个包很棒,但还不够成熟.

更新:ggvis目前处于休眠状态:https://github.com/rstudio/ggvis#status

library(ggvis)

ui <- fluidPage(
  ggvisOutput("plot")
)

server <- function(input, output) {

  iris %>%
    ggvis(~Sepal.Width, ~Petal.Width) %>%
    layer_points() %>%
    layer_lines() %>% 
    add_tooltip(function(df) { paste0("Petal.Width: ", df$Petal.Width) }) %>%
    bind_shiny("plot")
}

shinyApp(ui = ui, server = server)

EDITED

例5:

在这篇文章之后,我搜索了互联网,看看它是否可以比例3做得更好.我为ggplot 找到了这个精彩的自定义工具提示,我相信它很难做得更好.