简体   繁体   中英

How to use a highcharter event function in shiny module

My question is related to this post. By clicking on a bar in a bar plot I want to display the selected category. When rewriting the code into modules I do not get the expected result (ie display the category in text field), instead nothing happens not even an error message pops up. What am I doing wrong?

library(shiny)
library(highcharter)

myModuleUI <- function(id){
  ns <- NS(id)
  fluidPage(
    column(width = 8, highchartOutput(ns("hcontainer"), height = "500px")),
    column(width = 4, textOutput(ns("text")))
  )
}

myModule <- function(input, output, session){
  
  a <- data.frame(b = LETTERS[1:10], 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      
  })
  
}

ui <- shinyUI(fluidPage(
  myModuleUI("myMod")
  ))

server <- function(input, output){
  callModule(myModule, "myMod")
}

The thing with modules is that you need to pass the namespace. If you get the namespace in the beginning of your module ns <- session$ns and then adjust the JavaScript function like this

canvasClickFunction <- JS(paste0("function(event) {Shiny.onInputChange('", ns('canvasClicked'), "', [this.name, event.point.category]);}"))
legendClickFunction <- JS(paste0("function(event) {Shiny.onInputChange('", ns('legendClicked'), "', this.name);}"))

your code should work.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM