R Shiny如何点击actionButton在modalDialog中动态新增横向输入矩阵

实现方案 #

无需额外引入第三方R包，通过Shiny原生的insertUI、removeUI功能配合简单CSS即可实现需求，修改后的完整可运行代码如下：

library(shiny)
library(shinyjs)
library(shinyMatrix)

f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions       <- c("show", "reset")
tbl           <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Reset")
rownames(tbl) <- c("2nd input", "3rd input")

firstInput <- function(inputId){
  matrixInput(inputId, 
              value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

secondInput <- function(inputId,x){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

# 通用的场景输入生成函数
scenarioInput <- function(inputId,x, label = "输入矩阵"){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c(label),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "td .checkbox {margin-top: 0; margin-bottom: 0;}
       td .form-group {margin-bottom: 0;}
       .scenario-container {display: flex; gap: 20px; overflow-x: auto; padding: 10px 0;}
       .scenario-item {min-width: 200px;}"
    ))
  ),
  br(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      hidden(uiOutput("secondInput")),
      actionButton("showFourth","Show 4th input (in modal)",width = "100%")
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output){
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  # 记录当前场景数量
  scenario_cnt <- reactiveVal(1)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      firstInput("input1"),
      strong(helpText("Generate curves (Y|X):")),
      tableOutput("checkboxes") 
    )
  })
  
  output[["checkboxes"]] <- 
    renderTable({tbl}, 
                rownames = TRUE, align = "c",
                sanitize.text.function = function(x) x
    )
  
  observeEvent(input[["show1"]], {
    if(input[["show1"]]){shinyjs::show("secondInput")} else 
    {shinyjs::hide("secondInput")}
  })
  
  observeEvent(input$showFourth,{
    showModal(
      modalDialog(
        actionButton("add","Add scenario"), 
        actionButton("remove","Remove above", style = "margin-left: 10px;"),
        div(style = "margin-bottom: 10px"),
        # 横向滚动容器
        div(class = "scenario-container",
            div(class = "scenario-item", id = "scenario_1",
                scenarioInput("input4",if(isTruthy(input$input4)){input$input4} else {input$input2[1,1]}, label = "4th input")
            )
        ),
        footer = modalButton("Close"),
        size = "l"
      ))
  })
  
  # 新增场景逻辑
  observeEvent(input$add, {
    new_cnt <- scenario_cnt() + 1
    insertUI(
      selector = ".scenario-container",
      where = "beforeEnd",
      ui = div(class = "scenario-item", id = paste0("scenario_", new_cnt),
               scenarioInput(paste0("input_", new_cnt), input$input2[1,1], label = paste0(new_cnt, "th input"))
      )
    )
    scenario_cnt(new_cnt)
  })
  
  # 删除场景逻辑，保留至少1个
  observeEvent(input$remove, {
    if(scenario_cnt() > 1){
      removeUI(selector = paste0("#scenario_", scenario_cnt()))
      scenario_cnt(scenario_cnt() - 1)
    }
  })
  
  output$secondInput <- renderUI({
    req(input1())
    secondInput("input2",input$input1[1,1])
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <-renderPlot({
    req(input2())
    plot(rep(if(isTruthy(input$input4)){input$input4} else {input$input2()}, times=5))
  })
}

shinyApp(ui, server)

改动说明 #

• 新增了CSS样式实现横向滚动容器，所有输入矩阵横向排列，超出modal宽度时自动出现横向滚动条，无需担心最大扩展尺寸问题
• 新增响应式变量scenario_cnt记录当前场景数量，新增输入时自动生成唯一ID避免冲突
• 新增/删除按钮逻辑已绑定，删除时会保留至少1个输入矩阵，不会出现删空的情况
• 所有新增的输入矩阵默认值都关联secondInput的取值，符合链式关联要求
• 通用的scenarioInput函数替代原来的fourthInput，方便后续统一调整输入样式

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072