缩放区域高点闪亮R的点坐标

时间:2016-09-19 13:15:48

标签: javascript r highcharts shiny zoom

我有这个散点图,我想放大一个区域,然后将一个表子集化,只显示子集化点的数据。第一步是通过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)

正确打印轴边界但有一步延迟。有人可以帮忙吗?

最终解决方案

我通过处理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);
    }")

0 个答案:

没有答案