R Shiny模块化动态输入数据表：绑定与显示问题

可复现代码 #

library(shiny)
library(DT)
library(dplyr)

apply_selectInput <- function(X, ns) {
  paste0("selectInput(
    inputId = ", ns(paste0("type_input_", X[["row_name"]])), ",
    label = NULL,
    choices = c('Other','Sports Car','Family Car'),
    selectize = FALSE
  )")
}

get_data <- function() {
  ## 实际场景为从SQL拉取数据 ##
  data <- as.data.frame(mtcars) %>%
    mutate(`Car Name` = rownames(mtcars))
  return(data)
}

get_data_w_inputs <- function(data = get_data(), ns) {
  data$Type <- apply(
    X = data %>% mutate(row_name = rownames(data)),
    MARGIN = 1,
    FUN = function(x) apply_selectInput(x, ns)
  )
  return(data)
}

ui_function <- function(id) {
  ns <- NS(id)
  tagList(
    dataTableOutput(outputId = ns('dt')),
    uiOutput(outputId = ns('ui'))
  )
}

server_function <- function(input,output,session) {
  ns <- session$ns
  
  ## session$userData$vars用于跨模块读写数据 ##
  session$userData$vars <- reactiveValues(
    orig = get_data_w_inputs(ns = ns),
    filtered = get_data_w_inputs(ns = ns),
    changes = get_data_w_inputs(ns = ns),
    inputs = NULL
  )
  
  output$dt <- renderDataTable({
    datatable(
      session$userData$vars$filtered %>% 
        mutate(Type = as.character(eval(parse(text = Type)))),
      rownames = FALSE,
      escape = FALSE,
      editable = list(target = "cell"),
      fillContainer = TRUE,
      extensions = c('Buttons'),
      options = list(
        searching = FALSE,
        paging = FALSE,
        dom = 'tB',
        scrollY = '500px',
        fixedColumns = TRUE,
        autoWidth = TRUE,
        buttons = c('copy', 'csv', 'excel'),
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { 
          Shiny.bindAll(this.api().table().node()); 
          this.api().table().columns.adjust().draw(false);
        } ')
      )
    )
  })
  
  output$ui <- renderUI({
    print(input)
  })
}

## 仪表盘UI ##
ui <- dashboardPage(
  header = dashboardHeader(
    title = 'Test',
    controlbarIcon = shiny::icon("filter")
  ),
  sidebar = dashboardSidebar(),
  controlbar = dashboardControlbar(),
  body = dashboardBody(
    ui_function('datatable')
  )
)

## 仪表盘服务器 ##
server <- function(input, output, session) {
  ## 调用模块 ##
  callModule(server_function,'datatable')
}

shinyApp(ui,server)

问题原因与解决方案 #

问题1：添加绑定回调后表格消失（高度为0） #

• 根因：scrollCollapse = TRUE与动态生成的UI元素冲突，DT初始渲染时无法正确计算表格内容高度，导致容器高度被设为0；同时固定scrollY高度在动态UI加载后也会出现计算偏差。
• 解决方案：
  1. 移除scrollCollapse = TRUE参数，避免自动收缩高度的逻辑干扰；
  2. 在drawCallback中添加this.api().table().columns.adjust().draw(false);，手动触发列宽和表格高度的重新计算，确保动态UI加载后表格正常显示。

问题2：动态selectInput未正确绑定模块命名空间 #

• 根因：原apply_selectInput函数直接引用session$ns，但该函数不在模块服务器环境中，无法访问session对象，导致命名空间无法正确注入；仅最后一行偶有效果是渲染顺序的偶然因素。
• 解决方案：
  1. 给apply_selectInput添加ns参数，接收模块的命名空间函数；
  2. 在get_data_w_inputs中也添加ns参数，调用apply_selectInput时传入该参数；
  3. 模块服务器中调用get_data_w_inputs时，传入当前模块的ns函数，确保所有动态生成的selectInput都带有正确的模块命名空间前缀。

会话信息 #

R version 4.2.1 (2022-06-23)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04.4 LTS

other attached packages:
[1] DT_0.9

内容的提问来源于stack exchange，提问作者Toni H