我有这个散点图，我想放大一个区域，然后对表格进行子集化以仅显示子集化点的数据。第一步是通过 ZoomType = "xy" 完成的，但我在第二步中遇到了麻烦。谁能给我提示如何访问缩放区域的左上角和右下角点坐标，以便我可以对表格进行子集化？
谢谢！
library("shiny")
library("highcharter")
ui <- shinyUI(
fluidPage(
column(width = 8, highchartOutput("hcontainer", height = "500px")),
column(width = 4, textOutput("text"))
)
)
server <- function(input, output) {
dscars <- round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2)
dsplan <- round(mvrnorm(n = 10, mu = c(3, 4), Sigma = matrix(c(2,.5,2,2),2)), 2)
dstrck <- round(mvrnorm(n = 15, mu = c(5, 1), Sigma = matrix(c(1,.5,.5,1),2)), 2)
output$hcontainer <- renderHighchart({
canvasClickFunction <- JS("function(event) {Shiny.onInputChange('canvasClicked', [this.name, event.point.category]);}")
legendClickFunction <- JS("function(event) {Shiny.onInputChange('legendClicked', this.name);}")
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = T,
enabled = F,
pointFormat = paste0("<span style=\"color:{series.color};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list.parse2(as.data.frame(dscars)),marker = list(symbol = fa_icon_mark("car")),icon = fa_icon("car"), name = "car") %>%
hc_add_series(data = list.parse2(as.data.frame(dsplan)),marker = list(symbol = fa_icon_mark("plane")),icon = fa_icon("plane"), name = "plane") %>%
hc_add_series(data = list.parse2(as.data.frame(dstrck)),marker = list(symbol = fa_icon_mark("truck")),icon = fa_icon("truck"), name = "truck") %>%
hc_plotOptions(series = list(stacking = FALSE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction)))
})
makeReactiveBinding("outputText")
observeEvent(input$canvasClicked, {
outputText <<- paste0("You clicked on series ", input$canvasClicked[1], " and the bar you clicked was from category ", input$canvasClicked[2], ".")
})
observeEvent(input$legendClicked, {
outputText <<- paste0("You clicked into the legend and selected series ", input$legendClicked, ".")
})
output$text <- renderText({
outputText
})
}
shinyApp(ui, server)
第二次尝试 我尝试过类似的事情：
selectionfunction<- JS("function(event) {Shiny.onInputChange('range', [event.xAxis, event.yAxis]);}")
与：
hc_plotOptions(series = list(stacking = FALSE, events = list( selection=selectionfunction )))
makeReactiveBinding("outputText")
observeEvent(input$range, {
outputText <<- paste0("x= ", input$range[1],"y= " ,input$range[2])
})
output$text <- renderText({
outputText
})
但在我看来，当我缩放绘图时，不会调用函数选择函数。
几乎是一个很好的解决方案 我找到了一个几乎实用的解决方案：
library("shiny")
library("highcharter")
library("MASS")
ui <- shinyUI(
fluidPage(
column(width = 8, highchartOutput("hcontainer", height = "500px")),
column(width = 4, textOutput("text"))
)
)
server <- function(input, output) {
dscars <- round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2)
dsplan <- round(mvrnorm(n = 10, mu = c(3, 4), Sigma = matrix(c(2,.5,2,2),2)), 2)
dstrck <- round(mvrnorm(n = 15, mu = c(5, 1), Sigma = matrix(c(1,.5,.5,1),2)), 2)
output$hcontainer <- renderHighchart({
selectionfunction <- JS("function(event) {
Shiny.onInputChange('canvasClicked2', [event.xAxis[0].min , event.xAxis[0].max , event.yAxis[0].min , event.yAxis[0].max ] );}")
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy", events= list(selection=selectionfunction)) %>%
hc_tooltip(
useHTML = T,
enabled = F,
pointFormat = paste0("<span style=\"color:{series.color};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list.parse2(as.data.frame(dscars)),marker = list(symbol = fa_icon_mark("car")),icon = fa_icon("car"), name = "car") %>%
hc_add_series(data = list.parse2(as.data.frame(dsplan)),marker = list(symbol = fa_icon_mark("plane")),icon = fa_icon("plane"), name = "plane") %>%
hc_add_series(data = list.parse2(as.data.frame(dstrck)),marker = list(symbol = fa_icon_mark("truck")),icon = fa_icon("truck"), name = "truck")
})
makeReactiveBinding("outputText")
observeEvent(input$canvasClicked, {
outputText <<- paste0("You clicked on series ", input$canvasClicked[1], " and the bar you clicked was from category ", input$canvasClicked[2],input$canvasClicked[3], ".")
})
observeEvent(input$canvasClicked2, {
outputText <<- paste0(input$canvasClicked2[1]," ",input$canvasClicked2[2]," ",input$canvasClicked2[3]," ",input$canvasClicked2[4])
})
output$text <- renderText({
outputText
})
}
shinyApp(ui, server)
轴边界已正确打印，但有 1 步延迟。有人可以帮忙吗？
最终解决方案
我通过研究 JS 函数找到了解决方案：
selectionfunction1 <- JS("function(event) {
var x_axis_min,x_axis_max,y_axis_min,y_axis_max;
if (event.xAxis) {
x_axis_min = Highcharts.numberFormat(event.xAxis[0].min, 2),
x_axis_max = Highcharts.numberFormat(event.xAxis[0].max, 2);
}else{
x_axis_min = 'reset',
x_axis_max = 'reset';
}
if (event.yAxis) {
y_axis_min = Highcharts.numberFormat(event.yAxis[0].min, 2),
y_axis_max = Highcharts.numberFormat(event.yAxis[0].max, 2);
}else{
y_axis_min = 'reset',
y_axis_max = 'reset';
}
Shiny.onInputChange('canvasClickedxmin', x_axis_min);
Shiny.onInputChange('canvasClickedxmax', x_axis_max);
Shiny.onInputChange('canvasClickedymin', y_axis_min);
Shiny.onInputChange('canvasClickedymax', y_axis_max);
}")
谢谢你，它有效，很有帮助。