Here's a question for RShiny users. I have developed an application which has multiple routes on rendering UI, through action buttons, dropdowns and graph click events. My goal is to fully modularise the application.
The problem I am having with modularisation is using echarts4r e_on("click") functionality in a dynamically rendered UI. As an example of minimal working code (which reflects the process at the moment), I've used the dataset iris:
library(shiny)
library(DT)
library(echarts4r)
ui <- fluidPage(
fluidRow(br(),
br(),
actionButton("example_button", "Click button to see table"),
echarts4rOutput("example_plot"),
dataTableOutput("table_example"))
)
server <- function(input, output, session) {
group <- reactiveVal(iris)
output$example_plot <- renderEcharts4r({
iris %>%
group_by(Species) %>%
e_charts(Sepal.Length) %>%
e_scatter(Petal.Length, Sepal.Width) %>%
e_on(
"click",
"function(){
Shiny.setInputValue('example_plot_on_click', true, {priority: 'event'});
}"
)
})
observeEvent(input$example_plot_clicked_serie, {
group(filter(iris, Species == input$example_plot_clicked_serie))
})
output$table_example <- renderDataTable({
group()
})
}
shinyApp(ui, server)
Essentially, an echarts is rendered, a point is clicked and then fed into a reactive value. In this case, when you click on a species, it filters the Iris dataset for that species and displays in the DT Table. I'm not an expert at all in JS, but managed to get this working through shiny.setInputValue. In my app, the action buttons serve a similar purpose (i.e. filtering the table), but that is working so I've not included in the example code here. To put in context, this ui and server appears in multiple modal pop-ups, and include different buttons and charts for different groups (but the process for each of the modals is the same). Each button and chart (50-60 of these combo's across the app) all currently have an individual calls:
output$setosa_plot <- renderEcharts4r({
iris %>%
filter(Species == "Setosa") %>%
e_charts(Sepal.Length) %>%
e_scatter(Petal.Length, Sepal.Width) %>%
e_on(
"click",
"function(){
Shiny.setInputValue('setosa_plot_on_click', true, {priority: 'event'});
}"
)
})
observeEvent(input$setosa_plot_clicked_serie, {
group(filter(iris, Species == input$setosa_plot_clicked_serie))
})
In order to modularise, I'm intending to dynamically render the action button and echart (so each modal can share the same code). I have got the dynamic rendering working, and as an example, i've rendered a button and a chart for each species. The issue I am having is I can't access the click event as I do in the above example. I cannot find a solution, I've tried different methods. I essentially need to return the "species" that is clicked in any of those graphs to use in my filtering function.
ui <- fluidPage(
fluidRow(br(),
br(),
uiOutput("buttons_and_charts"),
dataTableOutput("table_example"))
)
server <- function(input, output, session) {
group <- reactiveVal(iris)
output$buttons_and_charts <- renderUI({
group_list <- unique(iris$Species)
test <- list()
for(i in unique(sort(group_list))){
test[[i]] <- fluidRow(actionButton(paste0(tolower(i), "_button"), i),
iris %>%
group_by(Species) %>%
e_charts(Sepal.Length) %>%
e_scatter(Petal.Length, Sepal.Width) %>%
e_on(
"click",
"function(){ Shiny.setInputValue('example_plot_on_click', true, {priority: 'event'});
}"
)
)
}
test
})
observeEvent(input$example_plot_clicked_serie, {
group(filter(iris, Species == input$example_plot_clicked_serie))
})
output$table_example <- renderDataTable({
group()
})
}
shinyApp(ui, server)
I'm not sure whether this is even possible, but it would be good to know nonetheless! Thanks in advance.
So after some time playing around with the code and different methods I found a way to ensure the dynamically rendered button UI as well as the rendered graphs could have individual click events associated to them (in the code above, its using the species in the Iris dataset whereas in my code the lists of groups changes depending on the modal clicked on.
I used these two Stack Overflow threads as the basis:
Shiny - Can dynamically generated buttons act as trigger for an event
Dynamically add button UI and associated observeEvents
My UI stayed the same with a dynamically rendered button for each graph:
ui <- fluidPage(
fluidRow(br(),
br(),
uiOutput("buttons_and_charts"),
dataTableOutput("table_example"))
)
My server is different to the original attempt. The same concept of looping through the list is applied, but a click event is provided to an empty list for both the button and the plot click.
server <- function(input, output, session){
group <- reactiveVal(iris)
obsList <- list()
graphNav <- list()
output$buttons_and_charts <- renderUI({
species_list <- sort(unique(iris$Species))
lapply(species_list, function(i){
btName <- paste0(tolower(i), "_button")
graphName <- paste0(tolower(i), "_plot")
if (is.null(obsList[[btName]])) {
obsList[[btName]] <<- observeEvent(input[[btName]], {
group(i)
})
}
fluidRow(actionButton(btName, i, style="font-size: 100%"),
echarts4rOutput(outputId = graphName, height = "50px")
)
}
)
})
observe({
species_list <- sort(unique(iris$Species))
lapply(species_list, function(i){
local({ #because expressions are evaluated at app init
ii <- i
graphName <- paste0(tolower(ii), "_plot")
graphNavigation <- paste0(tolower(ii), "_plot_clicked_serie")
group(NULL)
if (is.null(graphNav[[graphNavigation]])) {
graphNav[[graphNavigation]] <<- observeEvent(input[[graphNavigation]], {
group(i)
})
}
output[[paste0(graphName)]] <- renderEcharts4r({
iris %>%
filter(Species == ii) %>%
e_charts(Sepal.Length) %>%
e_scatter(Petal.Length, Sepal.Width) %>%
e_on(
"click",
paste0("function(){ Shiny.setInputValue('", graphName, "on_click', true, {priority: 'event'});}")
)
})
})
})
output$table_example <- renderDataTable({
datatable(iris %>%
filter(Species == group()))
})
})
}
shinyApp(ui, server)
So the with the dynamically rendered UI, you get a button, a graph and a reactive value that is determined by the above click events. This reactive is one of the 3 species in Iris which is used in the filter in the dataTableOutput. This works exactly how it needs to in my context, so hopefully will help others! Also feel free to take the code and improve it!