用高亮显示/隐藏系列/用动作按钮闪亮

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)