r - 在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 shiny!我们可以仅使用 plotOutput选项，例如 click， hover或 dblclick来使绘图具有交互性。 (See more examples in shiny gallery)

在下面的示例中，我们通过 hover = "plot_hover"添加“悬停”，然后指定默认为300ms的延迟。

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)

编辑过

示例5:

在这篇文章之后，我搜索了Internet以查看它是否比 示例3 更好。我发现 this是ggplot的绝妙自定义工具提示，我相信很难做到比这更好。