R Highcharter: выберите категорию из одной точки - PullRequest
Новая
       7

R Highcharter: выберите категорию из одной точки

0 голосов
/ 22 января 2019

Используя старшую диаграмму в R (используя пакет highcharter ) Я пытаюсь выбрать все точки для одной категории при выборе любой отдельной точки.Приведенный ниже код позволяет выбрать один фрагмент стека в гистограмме с накоплением.Я хочу, чтобы весь столбец сгруппировался, чтобы быть выбранным / отмененным, нажав на любой из срезов столбцов с накоплением. 

library("shiny")
library("highcharter")

ui <- shinyUI(
  fluidPage(
    column(width = 8, highchartOutput("hcontainer", height = "500px")),
    column(width = 4, textOutput("text"))
  )
)

server <- function(input, output) {      

  a <- data.frame(b = LETTERS[1:10], b_alt = LETTERS[11:20], c = 11:20, d = 21:30, e = 31:40)

  output$hcontainer <- renderHighchart({      

    canvasClickFunction <- JS("function(event) {Shiny.onInputChange('canvasClicked', [this.name, event.point.series.chart.series[0].options.additionalInfo[event.point.index]]);}")
    legendClickFunction <- JS("function(event) {Shiny.onInputChange('legendClicked', this.name);}")

    highchart() %>% 
      hc_xAxis(categories = a$b) %>% 
      hc_add_series(name = "c", additionalInfo = a$b_alt, data = a$c, color = "red") %>%
      hc_add_series(name = "d", data = a$d) %>% 
      hc_add_series(name = "e", data = a$e) %>%
      hc_plotOptions(series = list(stacking = TRUE, allowPointSelect = TRUE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction))) %>% 
      hc_chart(type = "column")

  })      

  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)

1 Ответ

0 голосов
/ 22 января 2019

Вы можете инициировать событие по нажатию точки (давайте назовем эту точку щелчка clickedPoint ) по всем сериям, а затем по всем точкам, проверьте, имеет ли точка ту же категорию, что и наша clickedPoint и если да, выберите его с помощью метода point.select ().

Вот основной код: 

hc_plotOptions(series = list(stacking = TRUE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction), point = list(events = list(click = JS(
    "function() {
      var clickedPoint = this;
        clickedPoint.series.chart.series.forEach(function(series) {
          series.points.forEach(function(point) {
            if (point.category === clickedPoint.category) {
              if (point.selected) {
                point.select(false, true)
              } else {
                point.select(true, true)
              }
            }
          })
        })
      }"
  ))))) %>%

А вот и весь код: 

library("shiny")
library("highcharter")

ui <- shinyUI(
  fluidPage(
    column(width = 8, highchartOutput("hcontainer", height = "500px")),
    column(width = 4, textOutput("text"))
  )
)

server <- function(input, output) {      

  a <- data.frame(b = LETTERS[1:10], b_alt = LETTERS[11:20], c = 11:20, d = 21:30, e = 31:40)

  output$hcontainer <- renderHighchart({      

    canvasClickFunction <- JS("function(event) {Shiny.onInputChange('canvasClicked', [this.name, event.point.series.chart.series[0].options.additionalInfo[event.point.index]]);}")
    legendClickFunction <- JS("function(event) {Shiny.onInputChange('legendClicked', this.name);}")

highchart() %>% 
  hc_xAxis(categories = a$b) %>% 
  hc_add_series(name = "c", additionalInfo = a$b_alt, data = a$c, color = "red") %>%
  hc_add_series(name = "d", data = a$d) %>% 
  hc_add_series(name = "e", data = a$e) %>%
  hc_plotOptions(series = list(stacking = TRUE, events = list(click = canvasClickFunction, legendItemClick = legendClickFunction), point = list(events = list(click = JS(
    "function() {
      var clickedPoint = this;
        clickedPoint.series.chart.series.forEach(function(series) {
          series.points.forEach(function(point) {
            if (point.category === clickedPoint.category) {
              if (point.selected) {
                point.select(false, true)
              } else {
                point.select(true, true)
              }
            }
          })
        })
      }"
  ))))) %>% 
  hc_chart(type = "column")

  })      

  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)

API: https://api.highcharts.com/class-reference/Highcharts.Point#select https://api.highcharts.com/highcharts/plotOptions.column.point.events.click

jsFiddle с чистой реализацией JS: https://jsfiddle.net/BlackLabel/p135s4vm/

...