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)

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

2 个答案: