Is there a way to make a wrapper function for renderUI in Shiny (R)?-CodePudding

I need to use renderUI to create multiple input options based on another input value. I want to wrap everything inside renderUI as a function so I can apply this to many similar inputs. Here is a simplified example (which is working for me, but I don't want to repeat the renderUI part many times, because I have many other inputs like the 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)

The problem is that when I tried to wrap it into a function, the output created by renderUI stops to update when I change the input value. Here is the code that doesn't work for me:

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)

CodePudding user response：

Though I don't see the point to do this because even you move that part to a function, you still have to define each sliderInput, here is one way to do it.

The point is you should wrap the Input instead of renderUI, because you need reactive expressions to be able to update input and reactive only works within another reactive or render* functions

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)

CodePudding user response：

Here is a possible alternative:

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)