在闪亮的 R 中使用 JS 事件函数两次来创建下拉列表
using JS event function twice in shiny R to create a dropdown
我正在构建一个闪亮的应用程序，我想要完成的其中一件事是创建一个下拉菜单。我想将劳动力变量绘制为不同级别的年份变量的函数。请参阅下面的示例数据框：
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 level_3 是通过单击图表 1 level_2 中的特定时间序列生成的）。但是，我想通过单击第二个高图（将输入第三个 chart/level_4）中的特定时间序列来执行类似的操作。
但是，我有点卡住了。我正在构建一个 webapp 通过单击第二个图表的时间序列，应该会出现第三个图表。我设法做到了这一点，但是当生成第三张图表时第二张图表消失了。我认为这与 clickevent 函数覆盖第一个 input$canvasClicked[[1]] 这一事实有关，但我无法通过 a) 使用 input$canvasClicked[[2]] 进行索引或 b) 创建第二个来获得正确的结果JS("function(event) { ... }").
如有任何帮助，我们将不胜感激！可以在下面找到简化应用程序的示例代码。
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)
感谢 Pork Chop，该应用程序正在运行。我需要更改新 JS("function(event) { ... }") 中的 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)
一旦我能够（两天后），我将接受答案以供参考。
我正在构建一个闪亮的应用程序，我想要完成的其中一件事是创建一个下拉菜单。我想将劳动力变量绘制为不同级别的年份变量的函数。请参阅下面的示例数据框：
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 level_3 是通过单击图表 1 level_2 中的特定时间序列生成的）。但是，我想通过单击第二个高图（将输入第三个 chart/level_4）中的特定时间序列来执行类似的操作。
但是，我有点卡住了。我正在构建一个 webapp 通过单击第二个图表的时间序列，应该会出现第三个图表。我设法做到了这一点，但是当生成第三张图表时第二张图表消失了。我认为这与 clickevent 函数覆盖第一个 input$canvasClicked[[1]] 这一事实有关，但我无法通过 a) 使用 input$canvasClicked[[2]] 进行索引或 b) 创建第二个来获得正确的结果JS("function(event) { ... }").
如有任何帮助，我们将不胜感激！可以在下面找到简化应用程序的示例代码。
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)
感谢 Pork Chop，该应用程序正在运行。我需要更改新 JS("function(event) { ... }") 中的 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)
一旦我能够（两天后），我将接受答案以供参考。