Question

我有一个动态的Shiny UI元素，系统会提示用户从下拉列表中选择一个数字（1-4）。然后，Shiny通过生成将由我的程序使用的相应数量的numericInput（）元素进行响应。

以下代码可以工作，但是处理起来很漫长，我想有一些方法可以将代码改进为（1）使其更简洁，以及（2）避免使用if / else语句。

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("num", label = h3("Select box"), 
                  choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3,
                                 "Choice 4" = 4), 
                  selected = 1),
      uiOutput("input_ui")
    ),
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output) {

  output$input_ui <- renderUI({
    num <- as.integer(input$num)
    if (num == 1) {
      fluidRow(
        column(6, numericInput("min", h5("Min"), value = 10)))
    } else if (num == 2) {
      fluidRow(
        column(6, numericInput("min", h5("Min"), value = 10)),
        column(6, numericInput("max", h5("Max"), value = 15))
      )
    } else if (num == 3) {
      fluidRow(
        column(6, numericInput("min", h5("Min"), value = 10)),
        column(6, numericInput("max", h5("Max"), value = 15)),
        column(6, numericInput("max", h5("Max"), value = 20))
      )
    } else if (num == 4) {
      fluidRow(
        column(6, numericInput("min", h5("Min"), value = 10)),
        column(6, numericInput("max", h5("Max"), value = 15)),
        column(6, numericInput("max", h5("Max"), value = 20)),
        column(6, numericInput("max", h5("Max"), value = 25))
      )
    }
  })
}

shinyApp(ui = ui, server = server)

有没有更好的方法来写这个？

请注意，在上面，值和标签是任意的。

Answer 1

您可以使用lapply()根据用户的选择创建多个（相似）UI元素。

为此替换服务器：

server <- function(input, output) {

  output$input_ui <- renderUI({
    req(input$num)
    if (as.numeric(input$num) > 1) {
    lapply(1:(as.numeric(input$num)-1), function(i) {
      numericInput(paste0("max",i), 
                   label=paste0("Max", i),
                   value = (i+2)*5)
    })
    }
  })
}

Answer 2

@phalteman的回答很好。另一种选择是完全删除服务器端代码，这以其自身的方式是有用的。

我们编写了一个函数，该函数创建输入的标签列表，并使用条件面板来检测选择了哪个输入。

library(shiny)

multiple_numeric_input <- function(names){
  taglst = tagList()
  for (name in names){
    taglst = tagAppendChild(taglst,column(6,numericInput(name,name,value = 10)))
  }
  return(fluidRow(taglst))
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("num", label = h3("Select box"), 
                  choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3,
                                 "Choice 4" = 4), 
                  selected = 1),
      conditionalPanel("input.num == 1",
                       multiple_numeric_input(c("min"))),
      conditionalPanel("input.num == 2",
                       multiple_numeric_input(c("min","max"))),
      conditionalPanel("input.num == 3",
                       multiple_numeric_input(c("min","max","min2"))),
      conditionalPanel("input.num == 4",
                       multiple_numeric_input(c("min","max","min2","max2")))
    ),
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)

如何改进代码以生成动态UI元素？

2 个答案: