有没有办法通过闪亮的方式从海图散点图中返回所有选定点？这个想法是动态地排除或包括要用于回归的点。我希望能够选择所需的点，将它们写入数据框，然后对它们执行非线性回归。到目前为止，我可以使用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
最佳答案
仅使用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
})
}
)
希望这可以帮助。