R shiny 动态 UI 将列添加到 tibble

Question

请参阅下图以获取底部附加的说明和可重现代码。

我有 3 个文本输入，分别称为Urgency 1 、 Urgency 2 、 Urgency 3 。 而且我有 1 个 uiOutput ，它将根据来自Number of modalities modalities 的数字输入创建额外的Modality Name 。 Tibble 的第 3、4、5 列（命名为2WW 、 Urgent 、 Routine ），这些名称基于 Urgency Urgency 1 、 Urgency Urgency 2 、 Urgency Urgency 3的输入。 到目前为止，一切都很好。

我还想要的是，当模态数变为 2 时，在第 5 列之后会在 tibble 中添加 3 个额外的列，它们将被命名为2WW2 、 Urgent2 、 Routine2 ，这使得 tibble 现在总共有 8 列. 当模态数变为 3 时，将多出 3 个额外的列，分别命名为2WW3 、 Urgent3 、 Routine3等。 当然2WW2 , Urgent2 , Routine2的名称，其中2WW , Urgent , Routine也来自于 Urgency Urgency 1 , Urgency 2 , Urgency Urgency 3的输入。

这不仅仅是在模态数量发生变化时添加额外的 3 列，而且如果模态数量减少，相关列也应该消失。

library(shiny)
library(purrr)
library(tidyverse)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("No_modalities", label = "Number of modalities",
                   value = 1, min = 1, max = 100, step = 1),
      textInput("urgency1", label = "Urgency 1", value = "2WW"),
      textInput("urgency2", label = "Urgency 2", value = "Urgent"),
      textInput("urgency3", label = "Urgency 3", value = "Routine"),
      uiOutput("modality"),
      width = 3
    ),
    mainPanel(
      dataTableOutput("template"),
      textOutput("check")
      , width = 9
    )
  )
)

server <- function(input, output, session) {
  modality_names <- reactive(paste0("Modality ", seq_len(input$No_modalities)))
  output$modality <- renderUI({
    map(modality_names(), ~ textInput(.x, label = paste(.x," Name"),
                                      value = isolate(input[[.x]])))
  })
  
  df1 = reactive({
    tibble(Column1 = rep(1,10), Column2 = rep(2,10),
           !!input$urgency1 := "",
           !!input$urgency2 := "",
           !!input$urgency3 := "")
  })
  
  output$template = renderDataTable({
    df1()
  })
  
}

shinyApp(ui, server)

Answer 1

经过多次尝试，我现在设法解决了这个问题。 我首先尝试将问题分解为更小的部分，例如，如何将字符串列表与 seq_len 组合以确保列名可以响应 input$No_modalities。 这是我的解决方案。 我使用可反应的reactable来显示数据表。

library(shiny)
library(reactable)
library(tidyverse)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("No_modalities", label = "Number of modalities",
                   value = 1, min = 1, max = 100, step = 1),
      textInput("urgency1", label = "Urgency 1", value = "2WW"),
      textInput("urgency2", label = "Urgency 2", value = "Urgent"),
      textInput("urgency3", label = "Urgency 3", value = "Routine"),
      uiOutput("modality"),
      width = 3
    ),
    mainPanel(
      reactableOutput("template"),
      textOutput("check")
      , width = 9
    )
  )
)

server <- function(input, output, session) {
  modality_names <- reactive(paste0("Modality ", seq_len(input$No_modalities)))
  
  output$modality <- renderUI({
    map(modality_names(), ~ textInput(.x, label = paste(.x," Name"),
                                      value = isolate(input[[.x]])))
  })
  
  df1 = reactive({
    tibble(Column1 = rep(1,10), Column2 = rep(2,10))
  })
  
  # columns to add
  columnsToAdd = reactive({
    c(outer(c(input$urgency1,input$urgency2,input$urgency3),
            seq_len(input$No_modalities), paste0))
  })

  df2 = reactive({add_column(df1(),!!!set_names(as.list(rep(1,
                                                      length(columnsToAdd()))),
                            nm=columnsToAdd()))})
    
  output$template = renderReactable({
      reactable(df2())
    })


}

shinyApp(ui, server)