Highcharter 闪亮事件 - 将多个选定点返回到数据框

Question

有没有办法通过闪亮从 highchart 中的散点图中返回所有选定的点？这个想法是动态排除或包含要用于回归的点。我希望能够选择所需的点，将它们写入数据框，然后对它们执行非线性回归。到目前为止，我可以使用here 和here 中的JavaScript 代码从图表中选择和取消选择点。我似乎无法将选定的点返回到数据框。 请在下面查看我的尝试。

#devtools::install_github("jbkunst/highcharter")
library(highcharter) 
library(htmlwidgets)
library(shiny)

#http://jsfiddle.net/gh/get/jquery/3.1.1/highcharts/highcharts/tree/master/samples/highcharts/chart/events-selection-points/

# selectPointsByDrag
s1 <- JS("/**
         * Custom selection handler that selects points and cancels the default zoom behaviour
         */
         function selectPointsByDrag(e) {

         // Select points
         Highcharts.each(this.series, function (series) {
         Highcharts.each(series.points, function (point) {
         if (point.x >= e.xAxis[0].min && point.x <= e.xAxis[0].max &&
         point.y >= e.yAxis[0].min && point.y <= e.yAxis[0].max) {
         point.select(true, true);
         }
         });
         });

         // Fire a custom event
         Highcharts.fireEvent(this, 'selectedpoints', { points: this.getSelectedPoints() });

         return false; // Don't zoom
         }")

# unselectByClick
s2 <- JS("/**
         * On click, unselect all points
         */
         function unselectByClick() {
         var points = this.getSelectedPoints();
         if (points.length > 0) {
         Highcharts.each(points, function (point) {
         point.select(false);
         });
         }
         }")


shinyApp(
  ui = fluidPage(
    uiOutput("selection_ui"),
    highchartOutput("plot_hc"),
    tableOutput("view") 

  ),
  server = function(input, output) {

    df <- data.frame(x = 1:50, y = 1:50, otherInfo = letters[11:15])
    df_copy <- df

    output$plot_hc <- renderHighchart({

      highchart() %>%
        hc_chart(zoomType = 'xy', events = list(selection = s1, click = s2)) %>%
        hc_add_series(df, "scatter") %>%
        hc_add_event_point(event = "select")


    })

    output$view <- renderTable({
      data.table(x = input$plot_hc_select$x, y = input$plot_hc_select$y)
    })

    observeEvent(input$plot_hc, print(paste("plot_hc", input$plot_hc)))

    output$selection_ui <- renderUI({

      if(is.null(input$plot_hc_select)) return()

      wellPanel("Coordinates of selected point: ",input$plot_hc_select$x, input$plot_hc_select$y)

    })

  }

)

错误：列或参数 1 为 NULL

Answer 1

仅使用 Highcharter 或 Highcharts（据我所知）没有直接的方法来实现您想要的。一种简单的方法是将每个选定的点存储在（javascript）数组中，并将其传递给 R。感谢 Shiny，这可以使用Shiny.onInputChange 轻松完成（参见示例here）。

您可以像这样重写您闪亮的应用程序以使其工作：

1) 在s1函数中，将选中的点存储在xArr中。

2) 使用Shiny.onInputChange 将xArr 传递给R。xArr 可以通过input$R_xArr 访问（我选择了名称R_xArr，它不是自动分配的）。

3) 使用reactiveValues 将选定的点存储在 R 侧。

4) 使用适当的观察者更新这些值。

#devtools::install_github("jbkunst/highcharter")
library(highcharter) 
library(htmlwidgets)
library(shiny)
library(data.table)

# selectPointsByDrag
s1 <- JS("/**
         * Custom selection handler that selects points and cancels the default zoom behaviour
         */
         function selectPointsByDrag(e) {
           var xArr = []
           // Select points
           Highcharts.each(this.series, function (series) {
             Highcharts.each(series.points, function (point) {
               if (point.x >= e.xAxis[0].min && point.x <= e.xAxis[0].max &&
                   point.y >= e.yAxis[0].min && point.y <= e.yAxis[0].max) {
                 xArr.push(point.x);
                 point.select(true, true);

               }
             });
           });
           Shiny.onInputChange('R_xArr', xArr);

           // Fire a custom event
           Highcharts.fireEvent(this, 'selectedpoints', { points: this.getSelectedPoints() });

           return false; // Don't zoom
           }")

# unselectByClick
s2 <- JS("/**
         * On click, unselect all points
         */
         function unselectByClick() {
           var points = this.getSelectedPoints();
           if (points.length > 0) {
             Highcharts.each(points, function (point) {
               point.select(false);
             });
           }
         }")

shinyApp(
  ui = fluidPage(
    highchartOutput("plot_hc"),
    tableOutput("view") 
  ),
  server = function(input, output) {

    df <- data.frame(x = 1:50, y = 1:50, otherInfo = letters[11:15])

    output$plot_hc <- renderHighchart({
      highchart() %>%
        hc_chart(zoomType = 'xy', events = list(selection = s1, click = s2)) %>%
        hc_add_series(df, "scatter") %>%
        hc_add_event_point(event = "unselect")
    })

    selected.points <- reactiveValues(x = NULL, y = NULL)

    output$view <- renderTable({
      if (is.null(selected.points$x) || is.null(selected.points$y)) {
        return(NULL)
      } else {
        data.table(x = selected.points$x, y = selected.points$y)  
      }
    })

    observeEvent(input$R_xArr, {
      selected.points$x <- sort(unique(c(selected.points$x, input$R_xArr)))
      selected.points$y <- df$y[df$x %in% selected.points$x]
    })

    observeEvent(input$plot_hc_unselect, {
      selected.points$x <- NULL 
      selected.points$y <- NULL
    })

  }

)

希望这会有所帮助。