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

Question

I'm building a shiny app and one of the things I want to accomplish is to create a dropdown menu. I want to plot the labour variable as a function of the year variable for the different levels. See below for a sample dataframe:

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

I made a simplified version of the app below. I found this answer and I would like to perform a similar action. The point is I'm stuck with writing the correct highcharter event function, which I can use with Shiny.onInputChange() . I would like to let the user click on the graph, save that value and use that value to filter and create a new highcharter graph. In this case: the first graph on level2 contains two time series with the groups 10 and 11. The user should be able to click on the timeserie named 10 and see the timeseries 101 and 102 (which is characterized as level_3).

Any help would be much appreciated! Another solution outside the highcharter event fuction would be allright as well.

    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

We can create specific event named canvasClicked as shown below, which will bind it to the points you clicked on chart1. then we are going to add an event listener to highchart in hc_plotOptions . If you would like to use the value in other funcitons you can access it via input$canvasClicked[[1]] , note that this is a list and you should index appropriately

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)