Assign/change div 动态生成的 ID UI 组件 (R Shiny/Javascript)

Question

我正在使用 uiOutput/renderUI 在 R shiny 应用程序中动态生成几个 table。这些 tables 是 editable，因为它们呈现检索到的数据，然后用户可以更改这些数据并将其发送以供进一步处理。我使用的是 rhandsontable，但实际上 DT、excelR 或任何其他 table 理论上都可以使用，但其中 none 的 ID 为属性。这是渲染页面目前的样子（对于 var3 中的每个新条目，都会渲染 3 tables 的新流体行）

每个 tables 的标签都是唯一的，可以在 table 创建期间用作标识符，就像我如何使用它在 tables 之上创建标签一样. 如果我检查元素并查找 table 的 div ID，我就能获得 table 的内容。例如这里使用 input$outbd32eabbd01a4806 给我数据。

但是这个 ID 在应用程序内部是未知的，table 的数量也是未知的。如果我在创建时用一个 ID 已知（例如 Sample2_Alpha）的 div 包装每个 table，它会在此动态 div 之上创建另一个 div 元素id，我还是搞不懂这个 table

我认为可能有几种方法可以解决这个问题，但我想到了以下方法。我不太熟悉 Javascript，但这些有可能吗？

在创建动态 table 时分配 div ID？在这种方法中，直接输入$varName 会给我 table 内容（需要使用 hot_to_r(input$varName) 来阅读这里）
如果我们用已知的 div ID 包装每个元素，那么该组件的子元素 div 呢？在这种方法中，我可以维护每个已知 div 及其子 div 的矩阵，我可以使用它来检索数据，就像上面一样。

谢谢

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 = "[=14=],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)

Answer 1

像这样：

一切都是从服务器动态生成的。

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)

好的，我考虑了你的方法，下面是javascript版本。基本上，按照您的要求，当您单击按钮时，它会向浏览器发送一个信号，浏览器会为您获取所有 table ID，并将其作为输入 table_ids 发送回 Shiny 中的 R。所以你只需要注意那个输入。确保更改 #test 以匹配 uiOutput('test') 的 ID，# 是必需的。由于不熟悉JS，就不细说了

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 = "[=11=],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)

Assign/change div 动态生成的 ID UI 组件 (R Shiny/Javascript)

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

javascript

r

shiny

shinydashboard