R仪表板中的Javascript：plot $ series（event = ...）

Question

我找到了一个示例here，它与我想做的完全匹配。

唯一的问题是我不知道将代码放置在R仪表板脚本中的位置。主持人说他做错了：代码必须放在plot $ series（event = ...）中，但是我可以在哪里放置plot $ series（event = ...）？

我尝试将其放在jsCode（程序包Shinyjs）的开头，但没有任何反应。我也在ui中尝试过...

library(highcharter)
library('shinyjs')

data_plot <- data.frame(categories = c("A", "B", "C", "D"),
                    serie1 = c(1563, 1458, 205, 695),
                    serie2 = c(562, 258, 17, 115),
                    serie3 = c(324, 654, 23, 987),
                    serie4 = c(123, 567, 234, 12),
                    serie5 = c(376, 88, 98, 123)
                    )
jsCode <- "
plot$series(event = legendItemClick = #! function(event) {
if (!this.visible )
return false;

var seriesIndex = this.index;
var series = this.chart.series;

for (var i = 0; i < series.length; i++)
{
if (series[i].index != seriesIndex)
{
series[i].visible ?
  series[i].hide() :
  series[i].show();
} 
}
return false;
} !#)"

ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),

dashboardSidebar(),

dashboardBody(highchartOutput ("hc1")))

server <- function(input, output,session) {

#Normal Chart
output$hc1 <- renderHighchart ({
Hch <- highchart(hcaes(x = Spring ,y = Ponctuation)) %>% 
  hc_title(text = "Graph",
           margin = 20, align = "left",
           style = list(color = "#FE8000", useHTML = TRUE)) %>% 
  hc_xAxis(categories = data_plot$categories, title = list(text = "Number 
 of spring",color = "#FE8000")) %>%
  hc_yAxis(title = list(text = "Result", color = "#FE8000"))%>% 
  hc_add_series(name = 'serie1', data = data_plot$serie1) %>% 
  hc_add_series(name = 'serie2', data = data_plot$serie2)%>% 
  hc_add_series(name = 'serie3', data = data_plot$serie3)%>% 
  hc_add_series(name = 'serie4', data = data_plot$serie4)%>% 
  hc_add_series(name = 'serie5', data = data_plot$serie5)

  Hch})


 }


 shinyApp(ui, server)

编辑

我更改了上面的jsCode，但这不起作用：

hc1$series(legendItemClick = function(event) {
if (!this.visible )
return false;

var seriesIndex = this.index;
var series = this.chart.series;

for (var i = 0; i < series.length; i++)
{
if (series[i].index != seriesIndex)
{
series[i].visible ?
series[i].hide() :
series[i].show();
} 
}
return false;
})

Answer 1

更新：

在这种情况下，我们真的不需要shinyjs，因为必须将js代码作为参数值传递给函数hc_plotOptions()，如上一个问题中提到的那样为event的值。

library(highcharter)
library(shiny)
library(shinydashboard)

data_plot <- data.frame(categories = c("A", "B", "C", "D"),
                        serie1 = c(1563, 1458, 205, 695),
                        serie2 = c(562, 258, 17, 115),
                        serie3 = c(324, 654, 23, 987),
                        serie4 = c(123, 567, 234, 12),
                        serie5 = c(376, 88, 98, 123)
)

jsCode <- JS("function(event) {
if (!this.visible )
return false;

var seriesIndex = this.index;
var series = this.chart.series;

for (var i = 0; i < series.length; i++)
{
if (series[i].index != seriesIndex)
{
series[i].visible ?
  series[i].hide() :
  series[i].show();
} 
}
return false;
}")

  ui <- dashboardPage(


    dashboardHeader(title = "My Dashboard"),

    dashboardSidebar(),

    dashboardBody(  

      highchartOutput ("hc1")))

  server <- function(input, output,session) {

    #Normal Chart
    output$hc1 <- renderHighchart ({
      Hch <- highchart(hcaes(x = Spring ,y = Ponctuation)) %>% 
        hc_title(text = "Graph",
                 margin = 20, align = "left",
                 style = list(color = "#FE8000", useHTML = TRUE)) %>% 
        hc_xAxis(categories = data_plot$categories, title = list(text = "Number 
 of spring",color = "#FE8000")) %>%
        hc_yAxis(title = list(text = "Result", color = "#FE8000"))%>% 
        hc_add_series(name = 'serie1', data = data_plot$serie1) %>% 
        hc_add_series(name = 'serie2', data = data_plot$serie2)%>% 
        hc_add_series(name = 'serie3', data = data_plot$serie3)%>% 
        hc_add_series(name = 'serie4', data = data_plot$serie4)%>% 
        hc_add_series(name = 'serie5', data = data_plot$serie5) %>% 
        hc_plotOptions(series = list(events = list(legendItemClick = jsCode)))

      Hch})


  }


  shinyApp(ui, server)