如何记住"在Shiny中用Plotly悬停值?

时间:2017-09-26 20:40:20

标签: r shiny plotly

我无法弄清楚Plotly的event_data(" plotly_hover")函数如何更新值,该值保持静态,直到有新输入。我怀疑Shiny的隔离({})功能可能是相关的,但我很难搞清楚如何。

在我的应用程序中,有两个图:一个是飞行的Leaflet地图,另一个是飞行测量的时间序列图。 Here is a screenshot of the app,here is a link to the beta app.我设置了图表,以便悬停在其中一个将在另一个上显示相应的位置(地图上的小图标和图表上的垂直线)。将鼠标悬停在其中将更新两者共享的时间坐标变量(" hoverdata")。地图会记住鼠标悬停数据;如果我离开它,一切都保持静止。但是如果我离开图表,Plotly的垂直线会回到中心的默认位置(或最后一个地图悬停输入)。再加上Plotly的悬停工具的缓慢,它会带来非常迟滞和不稳定的用户体验。

这是代码的相关部分。有一些粗劣的if / else东西正在进行,它不是很实用,只是尝试将垂直线的默认位置设置为绘图的开头,所以它看起来不像生涩。 (如果我将其他问题排除在外,我甚至不需要这样做。)

  # get map mouseover data
  mouseover_time <- reactive ({
    user_mouseover  <- input$flightpath_shape_mouseover
    mouseoverlat <- user_mouseover$lat
    mouseoverlon <- user_mouseover$lng
    subset(flightdata(), LATITUDE==mouseoverlat & LONGITUDE==mouseoverlon)$HMStime #  get time based on mouseover coordinates
  })

  # create shared time variable (x location of plotly's vertical line)
  hoverdata <- reactive  ({
    plot_hover <- event_data(event = "plotly_hover", source = "source") # plotly mouseover
    plot_hover <- plot_hover$x[1] # get x value
    if ((is.null(d)) && (is.null(mouseover_time()))) {
    flightdata()$HMStime[flightdata()$UTC == min(flightdata()$UTC)] }  # set default as beginning of flight (does not work!)
    else if (is.null(d)) mouseover_time()   # if there's no plotly input, use map input
    else d   # otherwise use plotly input
  })

我非常感谢任何意见或帮助,感谢您阅读本文。

1 个答案:

答案 0 :(得分:1)

正如我的评论中所述,我建议将observereactiveValues/ractiveVal而不是reactive一起用于此任务。这个答案将证明使用一些简单的闪亮应用程序。如果您对被动反应背后的理论以及何时更新感兴趣,请参阅this article

设置

执行此代码以加载所有必需的库并创建一些用于测试的变量

library(shiny)
library(plotly)

gg <- ggplot(mtcars, aes(wt,mpg)) + geom_point()
ui <- fluidPage(tabsetPanel(
  tabPanel("plot", plotlyOutput('plot')),
  tabPanel("hover data", verbatimTextOutput('text'))
))
show_message <- function(){message(Sys.time(), " updating hover_reactive")}

工作版本(观察/反应值)

下面是一个演示event_data("plotly_hover")的服务器端存储的应用。只要悬停数据发生变化,该值就会更新。

server1 <- function(input, output, session){
  output$plot <- renderPlotly(gg)
  hover_reactive <- reactiveVal()                 ## initialize
  observe({
    show_message()
    hover_data <- event_data("plotly_hover")
    if (!is.null(hover_data))
      hover_reactive(hover_data)                  ## set
  })
  output$text <- renderPrint({hover_reactive()})  ## get
}

shinyApp(ui, server1)

is.null检查是必要的,因为每次鼠标在图中但不在点上时,event_data("plotly_hover")将返回NULL

非工作版本(被动)

如果我们尝试对reactive应用类似的逻辑,它将失败。每当更新被动[timestamp] updating hover_reactive时,下一个应用程序将向RStudio控制台打印消息hover_reactive。此消息仅在切换到hover data标签后显示。到那时,event_data("plotly_hover")将返回NULL个鼠标,鼠标不会在图中的任何位置悬停。

server2 <- function(input, output, session){ 
  output$plot <- renderPlotly(gg)
  hover_reactive <- reactive({                     ## initialize/set
    show_message()
    hover_data <- event_data("plotly_hover")
    if (!is.null(hover_data))
      hover_data
    else
      "NA"
  })
  output$text <- renderPrint({hover_reactive()})   ## get
}

shinyApp(ui, server2)

这种延迟更新的原因是hover_reactive处于空闲状态,直到(直接或间接)显示给用户。

修复非工作版本

此解决方法仅供有类似问题的人参考。我不建议按原样使用它。

可以通过设置hover_reactive来防止outputOptions变为空闲。但是,只要鼠标没有悬停在任何点上,plotly仍然会发送NULL s。因此需要像last_not_null_hoverdata这样的备用变量。

server3 <- function(input, output, session){
  output$plot <- renderPlotly(gg)
  last_not_null_hoverdata = NULL                  ## initialize
  hover_reactive <- reactive({
    show_message()
    hover_data <- event_data("plotly_hover")
    if (!is.null(hover_data)){
      last_not_null_hoverdata <<- hover_data      ## set
      hover_data
    }
    else
      last_not_null_hoverdata                     ## get
  })
  output$text <- renderPrint({hover_reactive()})
  ## Prevent output$text from becoming idle when it is not displayed
  outputOptions(output, "text", suspendWhenHidden = FALSE)
}

shinyApp(ui, server3)