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

Question

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

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，我想做一个类似的动作。关键是我坚持编写正确的高图事件函数，我可以使用Shiny.onInputChange。我想让用户点击图表，保存该值并使用该值过滤并创建新的高图图表。在这种情况下：level2上的第一个图包含两个具有组10和11的时间序列。用户应该能够点击名为10的时间序列并查看时间序列101和102（其特征为level_3）。

任何帮助将非常感激！高清事件函数之外的另一个解决方案也是正常的。

    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)