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轻松完成（参见示例{{3}） }）。

可以像这样重写你闪亮的应用程序，使它工作：

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
    })

  }

)

希望这会有所帮助。

高清晰度闪亮事件 - 将多个选定点返回到数据帧

1 个答案: