问题
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.
回答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.
回答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)
来源：https://stackoverflow.com/questions/45374542/show-hide-serie-in-highchart-shiny-with-an-action-button