r - 有没有办法在 Shiny (R) 中为 renderUI 制作包装函数？

Question

我需要使用renderUI基于另一个输入值创建多个输入选项。我想把里面的所有东西都包装renderUI成一个函数，这样我就可以将它应用于许多类似的输入。这是一个简化的示例（对我有用，但我不想renderUI多次重复该部分，因为我有许多其他输入，例如i1）：

library(shiny)
ui <- fluidPage(
    fluidRow(
        selectInput(
            inputId = 'i1',
            label = 'choice 1',
            choices = list(5, 10)
        ),
        uiOutput('o1')
    )
)
server <- function(input, output, session) {
    output$o1 <- renderUI(
        fluidRow(
            sliderInput(
                inputId = 's1',
                label = 'slider 1',
                min = 0, max = as.numeric(input$i1) * 10,
                value = 0.5
            ),
            sliderInput(
                inputId = 's2',
                label = 'slider 2',
                min = 0, max = as.numeric(input$i1) * 100,
                value = 0.5
            )
        )
    )
}
shinyApp(ui = ui, server = server)

问题是当我试图将它包装到一个函数中时，renderUI当我更改输入值时，由创建的输出停止更新。这是对我不起作用的代码：

library(shiny)
renderUI_warpper <- function(i){
    renderUI(
        fluidRow(
            sliderInput(
                inputId = 's1',
                label = 'slider 1',
                min = 0, max = as.numeric(i) * 10,
                value = 0.5
            ),
            sliderInput(
                inputId = 's2',
                label = 'slider 2',
                min = 0, max = as.numeric(i) * 100,
                value = 0.5
            )
        )
    )
}
ui <- fluidPage(
    fluidRow(
        selectInput(
            inputId = 'i1',
            label = 'choice 1',
            choices = list(5, 10)
        ),
        uiOutput('o1')
    )
)
server <- function(input, output, session) {
    output$o1 <- renderUI_warpper(input$i1)
}
shinyApp(ui = ui, server = server)

Answer 1

虽然我看不出这样做的意义，因为即使您将该部分移动到一个函数中，您仍然必须定义 each sliderInput，这是一种方法。

关键是您应该包装 Input 而不是renderUI，因为您需要反应式表达式才能更新输入，而反应式仅适用于另一个反应式或render*函数

library(shiny)

ui <- fluidPage(
  fluidRow(
    selectInput(
      inputId = 'i1',
      label = 'choice 1',
      choices = list(5, 10)
    ),
    uiOutput('o1')
  )
)
server <- function(input, output, session) {
  wrapper <- reactive({
    function(i){
      fluidRow(
        sliderInput(
          inputId = 's1',
          label = 'slider 1',
          min = 0, max = as.numeric(i) * 10,
          value = 0.5
        ),
        sliderInput(
          inputId = 's2',
          label = 'slider 2',
          min = 0, max = as.numeric(i) * 100,
          value = 0.5
        )
      )
      }
  })
  output$o1 <- renderUI(wrapper()(input$i1))
}
shinyApp(ui = ui, server = server)

Answer 2

这是一个可能的替代方案：

library(shiny)

create_sliders <- function(i) {
  fluidRow(
    column(
      width = 12,
      sliderInput(
        inputId = "s1",
        label = "slider 1",
        min = 0, max = as.numeric(i) * 10,
        value = 0.5
      ),
      sliderInput(
        inputId = "s2",
        label = "slider 2",
        min = 0, max = as.numeric(i) * 100,
        value = 0.5
      )
    )
  )
}

ui <- fluidPage(
  fluidRow(
    selectInput(
      inputId = "i1",
      label = "choice 1",
      choices = list(5, 10)
    ),
    uiOutput("o1")
  )
)
server <- function(input, output, session) {
  output$o1 <- renderUI({
    create_sliders(input$i1)
  })
}
shinyApp(ui = ui, server = server)