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，以使图表具有互动性。 (See more examples in shiny gallery)

在下面的示例中，我们按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找到了this精彩的自定义工具提示，我相信它很难做得更好。

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

1 个答案: