在Shining R中使用JS事件函数两次以创建下拉列表

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

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

我已经知道如何获得第一个下拉列表（图2的级别为3，通过单击图1的级别为2的特定ime序列生成）。但是，我想通过单击第二个highchart（第三个图表/级别4）中的特定时间序列来执行类似操作

然而，我有点被卡住了。我正在通过点击第二个图表的时间序列来构建一个webapp，第三个图表应该会出现。我设法做到了这一点，但第二个图表在生成第三个图表时消失了。我认为这与clickevent函数覆盖第一个

input$canvasClicked[[1]]

有关，但我没有通过a）使用

input$canvasClicked[[2]]

索引或b）创建第二个

JS（“函数（事件）{…}”）

来获得正确的结果

任何帮助都将不胜感激！下面可以找到简化应用程序的示例代码

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

ui <- shinyUI(
  fluidPage(
    column(width = 4, highchartOutput("hcontainer", height = "500px")),
    column(width = 4, highchartOutput("hcontainer2", height = "500px")),
    column(width = 4, highchartOutput("hcontainer3", height = "500px")) #added add highcharter output
  )
)

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),
                   level_4 = c(c(1011, 1011, 1011, 1011, 1011, 1111, 1111, 1111, 1111, 1111,
                                 1021, 1021, 1021, 1021, 1021, 1122, 1122, 1122, 1122, 1122)), # additional level added
                   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("I clicked ",input$canvasClicked[[1]])) %>% 
      hc_plotOptions(series = list(events = list(click = canvasClickFunction2)))

  })

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

    output$hcontainer3 <- renderHighchart({ 
    req(input$canvasClicked2[[1]])

        temp3 <- df %>%
          filter(level_3 == input$canvasClicked2[[1]]) %>% # filter selected by click
          group_by(year, level_4) %>%
          summarize(Sum = sum(labour)) %>%
          arrange(level_4)

        hchart(temp3, "line", hcaes(x = year, y = Sum, group = level_4)) %>% 
          hc_title(text = paste0("I clicked ",input$canvasClicked2[[1]])) #%>%
    })

} 


shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（dplyr）
图书馆（高级特许）
ui%
安排（3级）
hchart（临时2，“直线”，HCAE（x=年份，y=总和，组=级别3））%>%
hc_标题（text=paste0（“我点击了”，输入$canvasClicked[[1]]））%>%
hc_绘图选项（系列=列表（事件=列表（单击=画布单击功能2）））
})
拉票功能2%
总结（总结=总结（劳动））%>%
安排（4级）
hchart（临时3，“直线”，HCAE（x=年份，y=总和，组=四级））%>%
hc#U标题（text=paste0（“我点击了”，输入$canvasClicked2[[1]]）#%>%
})
} 
shinyApp（用户界面=用户界面，服务器=服务器）

多亏了猪排，该应用程序才能正常运行。我需要更改新的

JS（“函数（事件）{…}”）

中的

canvasClicked

部分，以使应用程序正常工作。示例代码现在如下所示：

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

ui <- shinyUI(
  fluidPage(
    column(width = 4, highchartOutput("hcontainer", height = "500px")),
    column(width = 4, highchartOutput("hcontainer2", height = "500px")),
    column(width = 4, highchartOutput("hcontainer3", height = "500px")) #added add highcharter output
  )
)

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),
                   level_4 = c(c(1011, 1011, 1011, 1011, 1011, 1111, 1111, 1111, 1111, 1111,
                                 1021, 1021, 1021, 1021, 1021, 1122, 1122, 1122, 1122, 1122)), # additional level added
                   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("I clicked ",input$canvasClicked[[1]])) %>% 
      hc_plotOptions(series = list(events = list(click = canvasClickFunction2)))

  })

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

    output$hcontainer3 <- renderHighchart({ 
    req(input$canvasClicked2[[1]])

        temp3 <- df %>%
          filter(level_3 == input$canvasClicked2[[1]]) %>% # filter selected by click
          group_by(year, level_4) %>%
          summarize(Sum = sum(labour)) %>%
          arrange(level_4)

        hchart(temp3, "line", hcaes(x = year, y = Sum, group = level_4)) %>% 
          hc_title(text = paste0("I clicked ",input$canvasClicked2[[1]])) #%>%
    })

} 


shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（dplyr）
图书馆（高级特许）
ui%
安排（3级）
hchart（临时2，“直线”，HCAE（x=年份，y=总和，组=级别3））%>%
hc_标题（text=paste0（“我点击了”，输入$canvasClicked[[1]]））%>%
hc_绘图选项（系列=列表（事件=列表（单击=画布单击功能2）））
})
拉票功能2%
总结（总结=总结（劳动））%>%
安排（4级）
hchart（临时3，“直线”，HCAE（x=年份，y=总和，组=四级））%>%
hc#U标题（text=paste0（“我点击了”，输入$canvasClicked2[[1]]）#%>%
})
} 
shinyApp（用户界面=用户界面，服务器=服务器）

---

一旦我有能力（两天后），我将接受答案作为参考

您似乎要绑定它两次，这是第二个图表中的

canvasClickFunction

，我认为它根本不应该存在。创建另一个

canvasClickFunction2

并将其绑定到图表2

hc\u plotOptions

，然后将其用于图表3@Pork Chop。谢谢它正在工作！在创建第二个

canvasClicked函数

的旁边，我还需要更改

canvasClicked

。我会更新上面的应用程序。好的，很好：），一旦你更新了，请自己发布答案并接受它作为参考