Using e_on() to trigger an event within a dynamically rendered UI

Question

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.

Answer 1

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!

Answer 2

In this version of your app, you'll look for any buttons to be triggered. Within the observed event, you'll look at which button was triggered.

This depends on each plot being assigned an output from renderEcharts4r (which is still going to happen within renderUI).

I've added some style tags to the head of your ui. This is not necessary for the changes. I imagine that the reason your app is running off the left side is that there is more to this app than what's in this question. Feel free to delete all of the content within tags$head.

Other than the style tags, your ui does not change. There is no dataTableOutput, but that wasn't part of your question.

library(shiny)
library(tidyverse)
library(echarts4r)

ui <- fluidPage(
  tags$head(tags$style(HTML(".row{margin-left: 50px;}"))),
  fluidRow(
      br(), br(),
      uiOutput("buttons_and_charts"),
      dataTableOutput("table_example"))
)

Your server is quite a bit different. I've added some comments to clarify the 'what' and the 'why'.

server <- function(input, output, session) {

  # make the group list a global sorted vector
  group_list <- unique(sort(iris$Species)) %>% as.character()

  # set all buttons to ONE event, which will be observed individually within this event
  btns <- reactiveValues(buttons = actionButton(inputId = 'btn1', label = 1))

  # make the buttons and make space, so that each plot can be assigned a
  #    unique OUTPUT  (as in output$thisplot)
  output$buttons_and_charts <- renderUI({
    test <- lapply(group_list, function(i) {
      plotname <- paste0("plt_", i)
      btns$buttons[[i]] <- actionButton(paste0(tolower(i), "_button"), i)
      fluidRow(btns$buttons[[i]],
               echarts4rOutput(plotname, height = "25vh", width = "40vh")) # create space
    })
    do.call(tagList, test) # render the buttons and plot SPACE
  })
  
  # update the plot space with individual output$...
  for(i in group_list) {
    plotname <- paste0("plt_", i)
    local({
      output[[plotname]] <- renderEcharts4r({
        iris %>% 
          group_by(Species) %>% 
          e_charts(Sepal.Length) %>% 
          e_scatter(Petal.Length, Sepal.Width)
      })
    })
  }
  
  # observe for ANY button
  observeEvent(btns$buttons, { 
    for(that in 1:length(btns$buttons)) {
      local({
        what <- group_list[that]              # observe for WHICH button
        observeEvent(eventExpr = input[[paste0(tolower(what), "_button")]],
                     handlerExpr = {
                       echarts4rProxy(paste0("plt_", what)) %>%
                         e_remove_serie(serie_name = what) # remove content
                     })
      })
    }
  })
}