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

Question

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)

englealuze · Answer 1 · 2021-12-27T05:19:53.900

2

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)

edited Dec 27 '21 at 05:19

answered Dec 27 '21 at 04:47

englealuze

1,445
12
19

You can declare the function outside the server and then call it with `input$i1` as an argument. `create_sliders <- 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 ) ) }` – jpdugo17 Dec 27 '21 at 05:30
Inside the server: `output$o1 <- renderUI({ create_sliders(input$i1) })` – jpdugo17 Dec 27 '21 at 05:31
@jpdugo17 I am afraid that is equivalent to OP's proposal and will not update the scale when selectInput changes, since there is no reactive around `create_sliders` – englealuze Dec 27 '21 at 05:48
This worked for me and I like this idea: making the `warpper` a reactive function inside the server. Now I wonder why @jpdugo17's method worked for me as well. Based on @englealuze' comments it shouldn't have worked... – coffee Dec 27 '21 at 15:20
@coffee just tested that. it indeed works. I guess the `renderUI({ })` did the job to add some reactive features to a normal function such like `create_sliders` – englealuze Dec 27 '21 at 19:17

score 1 · Accepted Answer · answered Dec 27 '21 at 06:23

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)

Great, thanks. This indeed worked for me. I changed the function by moving `renderUI` out and it updated every time I changed the input or when a reactive value for the function changed. — coffee, Dec 27 '21 at 15:13

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

2 Answers2