使用操作按钮在 highchart/shiny 中显示/隐藏系列

Question

我希望能够在闪亮的高图中隐藏/显示系列。我希望获得与单击图例但单击按钮时相同的平滑变化。

我希望能够重现 this 行为，但要在闪亮的应用程序中。

到目前为止我的代码在这里。

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

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    shinyWidgets::materialSwitch(
      inputId = "button",
      label = "Button",
      value = FALSE
    ),
    div(id = "plotid", highchartOutput(outputId = "plot"))
  )
)

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

  output$plot <- renderHighchart({
    data_plot <- data.frame(source = c("display", "email", "search", "natural"),
                            serie1 = c(1563, 1458, 205, 695),
                            serie2 = c(562, 258, 17, 115))
    highchart() %>%
      hc_chart(
        type = 'bar'
      ) %>%
      hc_add_series(
        data = data_plot$serie1,
        name = 'Serie 1'
      ) %>%
      hc_add_series(
        data = data_plot$serie2,
        name = 'Serie 2'
      ) %>%
      hc_xAxis(
        categories = data_plot$source,
        title = list(text = 'Source')
      ) %>%
      hc_plotOptions(bar = list(stacking = 'normal'))
  })

}

shinyApp(ui = ui, server = server)

我不懂 javascript，也找不到获得我想要的东西的方法。

我试图获取图表对象以应用上面链接中给出的代码，但我做不到。现在我只知道使用

点击按钮时如何触发某些东西

tags$script('document.getElementById("button").onclick = function() {
\\ some code
                }'
    )

非常感谢您的帮助。

我的会话信息：

R version 3.4.1 (2017-06-30)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=French_France.1252  LC_CTYPE=French_France.1252    LC_MONETARY=French_France.1252
[4] LC_NUMERIC=C                   LC_TIME=French_France.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] highcharter_0.5.0    shinydashboard_0.5.1 shiny_1.0.3         

loaded via a namespace (and not attached):
 [1] Rcpp_0.12.10      compiler_3.4.1    plyr_1.8.4        bindr_0.1         xts_0.9-7        
 [6] tools_3.4.1       digest_0.6.12     jsonlite_1.3      lubridate_1.6.0   tibble_1.3.3     
[11] nlme_3.1-131      lattice_0.20-35   pkgconfig_2.0.1   rlang_0.1.1       psych_1.7.3.21   
[16] igraph_1.0.1      parallel_3.4.1    bindrcpp_0.2      dplyr_0.7.2       stringr_1.2.0    
[21] htmlwidgets_0.8   grid_3.4.1        data.table_1.10.4 glue_1.1.1        R6_2.2.0         
[26] foreign_0.8-69    TTR_0.23-1        reshape2_1.4.2    tidyr_0.6.1       purrr_0.2.2.2    
[31] magrittr_1.5      htmltools_0.3.5   rlist_0.4.6.1     assertthat_0.1    quantmod_0.4-7   
[36] mnormt_1.5-5      mime_0.5          xtable_1.8-2      httpuv_1.3.3      stringi_1.1.3    
[41] broom_0.4.2       zoo_1.7-14 

编辑：

为了澄清这个问题，当按钮被点击闪亮时，我希望隐藏第一个系列的情节，就像点击图例项目“Serie 1”一样。我不想重新渲染情节。

编辑 2：

将visible = input$button 添加到hc_add_serie 是我从我想要的最接近的，但它仍然不完全相同。我真的在寻找单击图例时出现的相同平滑/漂亮的动画。

Answer 1

经过一些试验和错误，我找到了使用一些 javascript 的解决方案。

代码如下：

library('shiny')
library('shinydashboard')
library('highcharter')
library('shinyjs')

jsCode <- "
shinyjs.toggleSerie = function(params) {
var serieToToggle = $('#plot').highcharts().get('idserie');
if(serieToToggle.visible){
serieToToggle.setVisible(false);
} 
else {
serieToToggle.setVisible(true);
}
}
"

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    extendShinyjs(text = jsCode),
    shinyWidgets::materialSwitch(
      inputId = "button",
      label = "Button",
      value = FALSE
    ),
    highchartOutput(outputId = "plot")
  )
)

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

  output$plot <- renderHighchart({
    data_plot <- data.frame(categories = c("A", "B", "C", "D"),
                            serie1 = c(1563, 1458, 205, 695),
                            serie2 = c(562, 258, 17, 115))
    highchart() %>%
      hc_chart(
        type = 'bar'
      ) %>%
      hc_add_series(
        data = data_plot$serie1,
        name = 'Serie to hide/show',
        id = 'idserie'
      ) %>%
      hc_add_series(
        data = data_plot$serie2,
        name = 'Serie 2'
      ) %>%
      hc_xAxis(
        categories = data_plot$categories,
        title = list(text = 'Categories')
      ) %>%
      hc_plotOptions(bar = list(stacking = 'normal'))
  })

  onclick(id = "button", expr = {
    js$toggleSerie()
  })

  session$onSessionEnded(stopApp)
}

shinyApp(ui = ui, server = server)

它提供了所需的行为。

Answer 2

你可以使用shinyjs，就像这样：

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

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    shinyWidgets::materialSwitch(
      inputId = "hide",
      label = "Button",
      value = FALSE
    ),
    div(id = "plotid", highchartOutput(outputId = "plot2"))
  )
)

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

  observeEvent(input$hide,{
    toggle("plot2")
  })


  output$plot2 <- renderHighchart({
    data_plot <- data.frame(source = c("display", "email", "search", "natural"),
                            serie1 = c(1563, 1458, 205, 695),
                            serie2 = c(562, 258, 17, 115))
    highchart() %>%
      hc_chart(
        type = 'bar'
      ) %>%
      hc_add_series(
        data = data_plot$serie1,
        name = 'Serie 1'
      ) %>%
      hc_add_series(
        data = data_plot$serie2,
        name = 'Serie 2'
      ) %>%
      hc_xAxis(
        categories = data_plot$source,
        title = list(text = 'Source')
      ) %>%
      hc_plotOptions(bar = list(stacking = 'normal'))
  })

}

shinyApp(ui = ui, server = server)

编辑：对单个系列使用图例：

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

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    shinyWidgets::materialSwitch(
      inputId = "hide",
      label = "Button",
      value = FALSE
    ),
    div(id = "plotid", highchartOutput(outputId = "plot2"))
  )
)

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

  observeEvent(input$hide,{
    toggle("plot2")
  })


  output$plot2 <- renderHighchart({
    data_plot <- data.frame(source = c("display", "email", "search", "natural"),
                            serie1 = c(1563, 1458, 205, 695),
                            serie2 = c(562, 258, 17, 115))
    highchart() %>%
      hc_chart(
        type = 'bar'
      ) %>%
      hc_add_series(
        data = data_plot$serie1,
        name = 'Serie 1'
      ) %>%
      hc_add_series(
        data = data_plot$serie2,
        name = 'Serie 2'
      ) %>%
      hc_xAxis(
        categories = data_plot$source,
        title = list(text = 'Source')
      ) %>%
      hc_plotOptions(bar = list(stacking = 'normal')) %>%
      hc_legend(align = "left", verticalAlign = "top",
                layout = "vertical", x = 0, y = 100)
  })

}

shinyApp(ui = ui, server = server)