无法使用悬停选项打印图形下的数据框（在 R Shiny 中）

Question

我有一个看起来像这样的数据框：

Taux_retour = as.Date(c("2020-06-11", "2020-06-12", "2020-06-13", "2020-06-15", 
                                      "2020-06-16", "2020-06-17", "2020-06-18", "2020-06-19", 
                                      "2020-06-20", "2020-06-22", "2020-06-23", "2020-06-24", "2020-06-25"))

Taux_retour=as.data.frame(Taux_retour)
Taux_retour$n = c(183,94,3,233,247,200,181,125,3,144,155,146,116)
Taux_retour$`Retour (%)`= c(1.55,0.79, 0.03, 1.97, 2.09, 1.69, 1.53, 1.06, 0.03, 1.22, 1.31, 1.23, 0.98)

在我闪亮的网络应用程序中，我想制作一个绘图并打印用于在图表下方创建它的 data.frame。 当我的电脑鼠标在某个点上时，我希望出现相关信息。例如，如果我指向第一个，希望 R 打印 data.frame 的第一行。

代码如下：

ui = dashboardPage(
                fluidRow(
                box(title = "Evolution du taux de retour : 
                    (pour plus de détails, passez votre souris sur les points)",
                    status = "success",
                    width = 9, 
                    solidHeader = TRUE,
                    plotOutput('graphique', 
                               click = "image_click",
                               hover = hoverOpts(id = "plot_hover", delayType = "throttle")),
                    uiOutput("dynamic"))))
server = function(input, output) {
  
  output$graphique= renderPlot({
    ggplot(data=Taux_retour, aes(x=Taux_retour,y=`Retour (%)`))+geom_line(col="steelblue", lwd=1) +
      ylim(min(Taux_retour$`Retour (%)`), max(Taux_retour$`Retour (%)`)) + theme_light() + theme(legend.position='none') +
      labs(y = "Taux de retour (en %)", x="Dates") +
      geom_line() + geom_point()+
      geom_vline(xintercept=as.numeric(as.Date(env1)+1), color = "olivedrab") +
      annotate(geom="text",x=as.Date(env1_g),y=2.0,label="Premier envoi", fontface="bold", color = "#006600")
  })
  
  output$dynamic <- renderUI({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover) # HERE
    req(nrow(y) != 0)
    verbatimTextOutput("vals")
  })
  
  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover) # HERE
    req(nrow(y) != 0)
    y
  }) 
  
}
shinyApp(ui = ui, server = server)

问题是当我将鼠标移到图表上时没有任何反应。我想我必须在代码中选择一些写有“# HERE”的行，但我无法得到什么！如果您有任何想法，那就太好了，我在那个错误上花了大约 8 个小时..

我也很抱歉我的语言中的错误......你一定明白我不是母语人士......

Answer 1

你不需要这个output$dynamic。只需在 UI 中输入verbatimTextOutput("vals")。

问题是由于您在nearPoints 函数中使用了iris，而您绘制的数据框是Taux_retour。将iris 替换为Taux_retour。

编辑

这里是代码。我评论了一些行，因为您没有提供对象 env1 和 env1_g。

ui = dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(title = "Evolution du taux de retour : 
        (pour plus de détails, passez votre souris sur les points)",
          status = "success",
          width = 9, 
          solidHeader = TRUE,
          plotOutput('graphique', 
                     click = "image_click",
                     hover = hoverOpts(id = "plot_hover", delayType = "throttle")),
          verbatimTextOutput("vals")
      )
    )
  )
)

server = function(input, output) {
  
  output$graphique= renderPlot({
    ggplot(data=Taux_retour, aes(x=Taux_retour,y=`Retour (%)`)) + 
      geom_line(col="steelblue", lwd=1) +
      ylim(min(Taux_retour$`Retour (%)`), max(Taux_retour$`Retour (%)`)) + 
      theme_light() + 
      theme(legend.position='none') +
      labs(y = "Taux de retour (en %)", x="Dates") +
      geom_line() + geom_point() #+
      # geom_vline(xintercept=as.numeric(as.Date(env1)+1), color = "olivedrab") +
      # annotate(geom="text",x=as.Date(env1_g),y=2.0,label="Premier envoi", fontface="bold", color = "#006600")
  })
  
  
  output$vals <- renderPrint({
    hover <- input$plot_hover 
    if(!is.null(hover)){
      points <- nearPoints(Taux_retour, hover) 
      if(nrow(points)) points
    }
  }) 
  
}

shinyApp(ui = ui, server = server)