Assign/change div ID of dynamically generated UI components (R Shiny/Javascript)

Question

I am dynamically generating a couple of tables in an R shiny app using uiOutput/renderUI. These tables are editable in that they present retrieved data, which the user can then change and send it for further processing. I am using rhandsontable, but essentially DT, excelR, or any other table can be used in theory- however none of them have an ID property. This is how the rendered page looks like as of now(for each new entry in var3, a new fluidrow of 3 tables is rendered)

Every tables's label is unique and can be used as an identifier during table creation, just like how I'm using it for creating label on top of tables. If I inspect element and look for a table's div ID, I am able to get content of the tables. eg here using input$outbd32eabbd01a4806 gives me the data.

However this ID is unknown inside the application and the number of tables are unknown. If I wrap each table with a div whose ID is known(eg Sample2_Alpha) at creation, it creates another div element on top of this dynamic div id and I still can't get hold of this table

I think there might be couple ways to go about it but following approaches come to mind. I'm not well versed with Javascript, but are any of these possible?

Assigning the div ID while creating dynamic table? In this approach, directly input$varName will give me table content(need to use hot_to_r(input$varName) to read here)
If we wrap each element with a known div ID, then the child div of that component? In this approach, I can maintain a matrix of each known div and their child div that I can use to retrieve data just as above.

Thank you

library(shiny)
library(rhandsontable)
library(shinyWidgets)
ui <- fluidPage(
  fluidRow(
    uiOutput('test'),
    actionBttn(
      inputId = "Id107",
      label = "button",
      style = "unite", 
      color = "danger"
    )
  )
)
server <- function(input, output, session) {
  var1 <-c(1,2,3)
  var2 <-c('X','Y','Z')
  var3 <-c('Sample1','Sample2')
  observeEvent(input$Id107,{
    #We should be able to get the input$ID of all dynamically generated tables here to retrieve any changes
    browser()
  })
  output$test = renderUI({
    table_names<-c('Alpha', 'Beta', 'Gamma')
    t<- matrix(data = 0, nrow = length(var2), ncol = length(var1)) %>%
      `rownames<-`(c(var2)) %>%
      `colnames<-`(c(var1))
    t1<-t
    t2<-t
    input_list <- lapply(1:length(var3), function(i) {
      new_list <- lapply(1:length(table_names),function(j) paste(var3[i] ," ", table_names[j], sep = "") )
      list(
        column(12,
               column(5,align='left',withTags(div(h5(b(new_list[1]))))),
               column(4,align='left',withTags(div(h5(b(new_list[2]))))),
               column(3,align='left',withTags(div(h5(b(new_list[3]))))),
        ),
        column(12,
               column(5,div(id = gsub("[^[:alnum:]]", "_", new_list[1]),renderRHandsontable(
                 rhandsontable(t, overflow='hidden',maxRows=nrow(t), minRows=nrow(t)) %>% 
                   hot_validate_numeric(c(1:ncol(t))) %>%
                   hot_table(stretchH = "all") %>%
                   hot_col(c(1:ncol(t)),format = "$0,0")))
               ),
               column(4,div(id = gsub("[^[:alnum:]]", "_", new_list[2]),renderRHandsontable(#
                 rhandsontable(t1, overflow='hidden',maxRows=nrow(t1), minRows=nrow(t1)) %>% 
                   hot_validate_numeric(c(1:ncol(t1))) %>%
                   hot_table(stretchH = "all") %>%
                   hot_col(c(1:ncol(t1)),format = "0.00%")))
               ),
               column(3,div(id = gsub("[^[:alnum:]]", "_", new_list[3]),renderRHandsontable(#
                 rhandsontable(t2, overflow='hidden',maxRows=nrow(t2), minRows=nrow(t2)) %>% 
                   hot_validate_numeric(c(1:ncol(t2))) %>%
                   hot_table(stretchH = "all") %>%
                   hot_col(c(1:ncol(t2)),format = "0")))
               )
        )
      )
    })
    do.call(tagList,input_list)
  })
}
shinyApp(ui, server)

why don't you use more shiny-ish way, use `rHandsontableOutput` and `renderRHandsontable` instead? `renderUI` is more static. — lz100, Nov 18 '21 at 17:59
I'm not aware how I can create unknown number of tables using rHandsontableOutput. Wouldn't each table generated this way need an output$ placeholder? I don't know in advance how many objects I need to create hence am resorting to renderUI. If you can share a snippet it'd be helpful — LBZR, Nov 18 '21 at 18:46
In R another way to acess `list` like structure is `list[['item_name']]`, so you can do `output[['xx']] <- xxx`. Wrap in `lapply(tables, function(x){output[[x]] <- xxx })`. You don't need to worry about scoping. Shiny is built on `R6`, parent environment assignment is handled for you. Otherwise you can try to use `do.call`. — lz100, Nov 18 '21 at 20:55
Thank you- so I will essentially iterate over tables(whose name are dynamically generated) and for each such name create an `output[[table_name]]` list by assigning appropriate `renderRHandsontable` on server side? So that makes perfect sense. But I'm a little confused on how I'd use `rHandsontableOutput` with that unknown table name in UI.R? Or am I still working with `renderUI/uiOutput` notation? Apologies if this is simple but I'm new to this - if you can show me an example with just one table, that'd really unblock me- thanks again for your input on this — LBZR, Nov 18 '21 at 22:54

lz100 · Accepted Answer · 2021-11-19T00:07:03.033

like this:

Everything is dynamically generated from the server.

library(shiny)
library(rhandsontable)
# give me random 1 - 9 numbers of tables
n_tables <- sample(9, size = 1)
tablenames <- paste0("iris", seq(n_tables))
# for demo, I just use the same dataset repeatedly, but with different now numbers
table_content <-  lapply(seq(n_tables), function(x) head(iris, n = x * 2))
names(table_content) <- tablenames

ui <- fluidPage(
  uiOutput("tables"),
  verbatimTextOutput("print_table")
  
)

server <- function(input, output, session) {
  output$tables <- renderUI({
      tagList(
          lapply(tablenames, function(x) {
              rHandsontableOutput(x)
          }),
          selectInput("choose_tb", "get a table's value", choices = tablenames)
      )

  })
  
  lapply(tablenames, function(x){
      output[[x]] <- renderRHandsontable(rhandsontable(table_content[[x]]))
  })
  # to get the values 
  observeEvent(input$choose_tb, {
      req(input$choose_tb)
      output$print_table <- renderPrint({
          print(hot_to_r(input[[input$choose_tb]]))
      })
  }, ignoreInit = TRUE)
}

shinyApp(ui, server)

Ok, I thought about your approach, and below is the javascript version. Basically, as you requested, when you click the button, it sends a signal to the browser and browser get all the table IDs for you and it sends back to R in Shiny as the input table_ids. So you just need to watch for that input. Make sure you change #test to match the ID of uiOutput('test'), # is required. Since you are not familiar with JS, not going with details

library(shiny)
library(rhandsontable)
library(shinyWidgets)
getIds <- function(session){
    session$sendCustomMessage("get_table_ids", list())
}

ui <- fluidPage(
    fluidRow(
        uiOutput('test'),
        actionBttn(
            inputId = "Id107",
            label = "button",
            style = "unite", 
            color = "danger"
        )
    ),
    tags$script(
        '
        Shiny.addCustomMessageHandler("get_table_ids", function(data){
            let ids = $("#test .rhandsontable.html-widget").map(function(){return $(this).prop("id")}).get();
            console.log(ids);
            Shiny.setInputValue("table_ids", ids);
        })
        '
    )
)
server <- function(input, output, session) {
    var1 <-c(1,2,3)
    var2 <-c('X','Y','Z')
    var3 <-c('Sample1','Sample2')
    observeEvent(input$Id107,{
        getIds(session)
    })
    observe({
        req(input$table_ids)
        print(input$table_ids)
    })
    output$test = renderUI({
        table_names<-c('Alpha', 'Beta', 'Gamma')
        t<- matrix(data = 0, nrow = length(var2), ncol = length(var1)) %>%
            `rownames<-`(c(var2)) %>%
            `colnames<-`(c(var1))
        t1<-t
        t2<-t
        input_list <- lapply(1:length(var3), function(i) {
            new_list <- lapply(1:length(table_names),function(j) paste(var3[i] ," ", table_names[j], sep = "") )
            list(
                column(12,
                       column(5,align='left',withTags(div(h5(b(new_list[1]))))),
                       column(4,align='left',withTags(div(h5(b(new_list[2]))))),
                       column(3,align='left',withTags(div(h5(b(new_list[3]))))),
                ),
                column(12,
                       column(5,div(id = gsub("[^[:alnum:]]", "_", new_list[1]),renderRHandsontable(
                           rhandsontable(t, overflow='hidden',maxRows=nrow(t), minRows=nrow(t)) %>% 
                               hot_validate_numeric(c(1:ncol(t))) %>%
                               hot_table(stretchH = "all") %>%
                               hot_col(c(1:ncol(t)),format = "$0,0")))
                       ),
                       column(4,div(id = gsub("[^[:alnum:]]", "_", new_list[2]),renderRHandsontable(#
                           rhandsontable(t1, overflow='hidden',maxRows=nrow(t1), minRows=nrow(t1)) %>% 
                               hot_validate_numeric(c(1:ncol(t1))) %>%
                               hot_table(stretchH = "all") %>%
                               hot_col(c(1:ncol(t1)),format = "0.00%")))
                       ),
                       column(3,div(id = gsub("[^[:alnum:]]", "_", new_list[3]),renderRHandsontable(#
                           rhandsontable(t2, overflow='hidden',maxRows=nrow(t2), minRows=nrow(t2)) %>% 
                               hot_validate_numeric(c(1:ncol(t2))) %>%
                               hot_table(stretchH = "all") %>%
                               hot_col(c(1:ncol(t2)),format = "0")))
                       )
                )
            )
        })
        do.call(tagList,input_list)
    })
}
shinyApp(ui, server)

You rock! Thank you good sir! I'll use your first approach so that I can learn more about R's abilities — LBZR, Nov 19 '21 at 00:11

Assign/change div ID of dynamically generated UI components (R Shiny/Javascript)

1 Answers1

Linked