在renderPlotly单击事件中使用nearPoints时出现闪亮错误

时间:2017-08-05 18:43:09

标签: r plotly shiny ropensci

我想使用点击事件中的数据来抓取nearPoints

我在Shiny webpage找到了以下代码段,它可以正常运行。

output$plot <- renderPlot({
  d <- data()
  plot(d$speed, d$dist)
})

output$plot_clickedpoints <- renderPrint({
  # For base graphics, we need to specify columns, though for ggplot2,
  # it's usually not necessary.
  res <- nearPoints(data(), input$plot_click, "speed", "dist")
  if (nrow(res) == 0)
    return()
  res
})

我试图模仿以上方法,使用点击事件数据识别Plotly图中的nearPoints。但是,它没有用。

output$plot <- renderPlotly({
  d <- data()
  plot(d$speed, d$dist)
})

output$plot_clickedpoints <- renderPrint({
  # For base graphics, we need to specify columns, though for ggplot2,
  # it's usually not necessary.
  res <- nearPoints(data(), event_data("plotly_click"), "speed", "dist")
  if (nrow(res) == 0)
    return()
  res
})

关于如何将坐标信息传递给情节图的任何想法?

2 个答案:

答案 0 :(得分:2)

我不确定如何使用nearPoints函数执行此操作,但是真的需要使用该函数吗?您可以使用以下代码找到在点击点的阈值范围内的点:

library(shiny)
library(plotly)
library(DT)

threshold_mpg = 3
threshold_cyl = 1

shinyApp(

  ui <- shinyUI(
    fluidPage(
      plotlyOutput("plot"),
      DT::dataTableOutput("table")
    )
  ),
  function(input,output){

    data <- reactive({
      mtcars
    })

    output$plot <- renderPlotly({
      d <- data()
      plot_ly(d, x= ~mpg, y=~cyl, mode = "markers", type = "scatter", source="mysource")
    })

    output$table<- DT::renderDataTable({

      event.data <- event_data("plotly_click", source = "mysource")
      print(event.data)
      if(is.null(event.data)) { return(NULL)}

      # A simple alternative for the nearPoints function
      result <- data()[abs(data()$mpg-event.data$x)<=threshold_mpg & abs(data()$cyl-event.data$y)<=threshold_cyl, ]
      DT::datatable(result)
    })
  }
)

希望这有帮助。

答案 1 :(得分:1)

"plotly_selected" plotly.js event返回的信息比event_data("plotly_selected")实际提供给你的信息多,包括坐标信息(这可能是event_data()设计错误,改变太晚了)。幸运的是,如果您了解一些JavaScript,知道如何listen to plotly select events以及如何send data from client to a shiny server,您可以执行以下操作来访问该信息:

library(shiny)
library(plotly)
library(htmlwidgets)

ui <- fluidPage(
  plotlyOutput("p"),
  verbatimTextOutput("info")
)

server <- function(input, output, session, ...) {

  output$p <- renderPlotly({
    plot_ly(x = 1:10, y = 1:10) %>%
      layout(dragmode = "select") %>%
      onRender(
       "function(el, x) {
         var gd = document.getElementById(el.id);
         gd.on('plotly_selected', function(d) {
            // beware, sometimes this event fires objects that can't be seralized
            console.log(d);
            Shiny.onInputChange('my-select-event', d.range)
         })
       }")
  })


  output$info <- renderPrint({
    print(session$rootScope()$input[["my-select-event"]])
  })

}

shinyApp(ui, server)

使用坐标信息,您可以编写一个与nearPoints()类似的函数。