r-如何在闪亮模块中使用highcharter事件功能



我的问题与这篇文章有关。通过单击条形图中的条形图,我希望显示所选类别。当将代码重写到模块中时,我没有得到预期的结果(即在文本字段中显示类别(,相反,什么都没有发生,甚至不会弹出错误消息。我做错了什么?

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")
}

模块的问题是需要传递命名空间。如果您在模块ns <- session$ns的开头获得名称空间,然后像以下一样调整JavaScript函数

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);}"))

您的代码应该可以工作。

最新更新