1

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 (i.e. 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")
}
4

0 回答 0