dnschneid / crouton

Chromium OS Universal Chroot Environment
https://goo.gl/fd3zc?si=1
BSD 3-Clause "New" or "Revised" License
8.55k stars 1.24k forks source link

Coordinates of zoomed area highchart shiny R #2782

Closed hmgs92 closed 7 years ago

hmgs92 commented 8 years ago

I have this scatter plot where I want to zoom in an area and then subset a table to show only the data from the subsetted points. The first step is done by zoomType = "xy", but I'm having troubles on the second step. Could anyone give me a hint on how can I access the upper left and bottom right points coordinates of the zoomed area, so I can subset the table?

Thank you!

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) 
drinkcat commented 7 years ago

262.