如何在 Shiny R 中创建 highcharter 事件函数以创建“下拉函数”

Question

我正在构建一个shiny 应用程序，我想要完成的一件事是创建一个下拉菜单。我想将劳动变量绘制为不同级别的年份变量的函数。请参阅下面的示例数据框：

year level_2 level_3 labour
1  2013      10     101      1
2  2014      10     101      5
3  2015      10     101     10
4  2016      10     101     20
5  2017      10     101     25
6  2013      11     111      5
7  2014      11     111     10
8  2015      11     111     20
9  2016      11     111     25
10 2017      11     111     30
11 2013      10     102      2
12 2014      10     102      6
13 2015      10     102     11
14 2016      10     102     21
15 2017      10     102     26
16 2013      11     112      6
17 2014      11     112     11
18 2015      11     112     21
19 2016      11     112     26
20 2017      11     112     31

我在下面制作了一个简化版的应用程序。我找到了这个answer，我想执行类似的操作。关键是我坚持编写正确的 highcharter 事件函数，我可以将其与Shiny.onInputChange() 一起使用。我想让用户点击图表，保存该值并使用该值过滤并创建一个新的 highcharter 图表。在这种情况下：level2 上的第一个图包含两个时间序列，组 10 和 11。用户应该能够单击名为 10 的时间序列并看到时间序列 101 和 102（其特征为 level_3）。

任何帮助将不胜感激！除了 highcharter 事件功能之外的另一种解决方案也可以。

    library(shiny)
library(dplyr)
library(highcharter)

ui <- shinyUI(
  fluidPage(
    column(width = 4, highchartOutput("hcontainer", height = "500px")),
    column(width = 4, highchartOutput("hcontainer2", height = "500px"))
  )
)

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

df <- data.frame(year = c(rep(c(2013, 2014, 2015, 2016, 2017), 4)),
                 level_2 = c(rep(c(10, 10, 10, 10, 10, 11, 11, 11, 11, 11),2)),
                 level_3 = c(101, 101, 101, 101, 101, 111, 111, 111, 111, 111,
                             102, 102, 102, 102, 102, 112, 112, 112, 112, 112),
                 labour = c(1, 5, 10, 20, 25, 5, 10, 20, 25, 30,
                            2, 6, 11, 21, 26, 6, 11, 21, 26, 31))

  output$hcontainer <- renderHighchart({

    temp <- df %>%
      group_by(year, level_2) %>%
      summarize(Sum = sum(labour)) %>%
      arrange(level_2)

    hchart(temp, "line", hcaes(x = year, y = Sum, group = level_2))

  })

  #second highcharter which should appear when user clicked on the serie named 10
  output$hcontainer2 <- renderHighchart({

    temp2 <- df %>%
      filter(level_2 == 10) %>% # filter selected by click
      group_by(year, level_3) %>%
      summarize(Sum = sum(labour)) %>%
      arrange(level_3)

    hchart(temp2, "line", hcaes(x = year, y = Sum, group = level_3))

  })


}


shinyApp(ui = ui, server = server)

Answer 1

我们可以创建名为canvasClicked 的特定事件，如下所示，它将绑定到您在chart1 上单击的点。然后我们将在hc_plotOptions 的highchart 中添加一个事件监听器。如果您想在其他功能中使用该值，您可以通过input$canvasClicked[[1]] 访问它，请注意这是一个列表，您应该适当索引

library(shiny)
library(dplyr)
library(highcharter)

ui <- shinyUI(
  fluidPage(
    column(width = 6, highchartOutput("hcontainer", height = "500px")),
    column(width = 6, highchartOutput("hcontainer2", height = "500px"))
  )
)

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

  df <- data.frame(year = c(rep(c(2013, 2014, 2015, 2016, 2017), 4)), 
                   level_2 = c(rep(c(10, 10, 10, 10, 10, 11, 11, 11, 11, 11),2)), 
                   level_3 = c(101, 101, 101, 101, 101, 111, 111, 111, 111, 111, 
                               102, 102, 102, 102, 102, 112, 112, 112, 112, 112), 
                   labour = c(1, 5, 10, 20, 25, 5, 10, 20, 25, 30,
                              2, 6, 11, 21, 26, 6, 11, 21, 26, 31))

  output$hcontainer <- renderHighchart({ 

    temp <- df %>% 
      group_by(year, level_2) %>% 
      summarize(Sum = sum(labour)) %>% 
      arrange(level_2) 
    hchart(temp, "line", hcaes(x = year, y = Sum, group = level_2)) %>%
      hc_plotOptions(series = list(events = list(click = canvasClickFunction)))

  })

  canvasClickFunction <- JS("function(event) {Shiny.onInputChange('canvasClicked', [this.name, event.point.category]);}")


  #second highcharter which should appear when user clicked on the serie named 10
  output$hcontainer2 <- renderHighchart({ 
    req(input$canvasClicked[[1]])
    temp2 <- df %>% 
      filter(level_2 == input$canvasClicked[[1]]) %>% # filter selected by click
      group_by(year, level_3) %>% 
      summarize(Sum = sum(labour)) %>% 
      arrange(level_3)
    hchart(temp2, "line", hcaes(x = year, y = Sum, group = level_3)) %>%
    hc_title(text = paste0("Thank you PorkChop, I clicked ",input$canvasClicked[[1]]))

  })

} 


shinyApp(ui = ui, server = server)