R Highcharter:点击类别的不同显示和价值

R Highcharter: Different display and value for clicked category

是否可以在 highcharter 图表中存储类别的隐藏值,以便在单击图表时返回隐藏值?

下面的代码 () 显示使用 input$canvasClicked[2] 单击的类别,以及使用 hc_xAxis(categories = a$b) 添加到图表的类别。相反,是否可以让 a$b_alt 从点击事件返回,同时仍将 a$b 作为图表中显示的类别?目的是将图表类别的格式与基础值分开。

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.category]);}")
    legendClickFunction <- JS("function(event) {Shiny.onInputChange('legendClicked', this.name);}")

    highchart() %>% 
      hc_xAxis(categories = a$b) %>% 
      hc_add_series(name = "c", data = a$c) %>%
      hc_add_series(name = "d", data = a$d) %>% 
      hc_add_series(name = "e", data = a$e) %>%
      hc_plotOptions(series = list(stacking = FALSE, 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) 

您可以将 b_alt 变量作为附加信息添加到第一个系列:

hc_add_series(name = "c", additionalInfo = a$b_alt, data = a$c) %>%

然后您可以在此处的第一个系列对象中找到此 additionalInfo 变量:

event.point.series.chart.series[0].options.additionalInfo[event.point.index]

整个代码:

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) %>%
      hc_add_series(name = "d", data = a$d) %>% 
      hc_add_series(name = "e", data = a$e) %>%
      hc_plotOptions(series = list(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)