通过操作按钮以高图表显示/隐藏系列

Question

I want to be able to hide/show a serie in a highchart plot in shiny. I want to have the same smooth change as the one obtained when clicking on the legend but when clicking on a button.

I want to be able to reproduce this behaviour but in a shiny app.

My code so far is here.

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)

I do not know javascript and I could not find a way to have what I want.

I tried to get the chart object in order to apply the code given in the link above but I could not. For now I only know how to trigger something when clicking on the button using

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

Thanks a lot for your help.

My session info:

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 

Edit :

To clarify the question, when the button is clicked in shiny I want the first serie of the plot to be hidden, exactly like it would happen if the legend item "Serie 1" is clicked. I do not wnt to rerender the plot.

Edit 2 :

Adding visible = input$button to hc_add_serie is the closest I get from what I want but it is still not exactly the same. I am really looking for the same smooth/nice animation that occurs when the legend is clicked.

Answer 1

After some trials and errors I found the solution using some javascript.

Here is the code :

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)

It gives the desired behaviour.

Answer 2

You can use shinyjs for that, like so:

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)

Edit: Using Legends for individual series:

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)