Create Dynamic Number of Input Elements with R/Shiny

Dynamic number of input widgets in shiny

The problem is not with the if (is.null(infile)) statement, it is with the lapply function. When the Shiny app just starts, the entire server function is executed, the length of inVars() is 0 and the sequence seq(pvars) will be 1 0. Then the numericInput will fail because you are making a reference to pvars[i] when i is equal to 0.

Below is the code that fixes the problem and also answers your questions.

library(shiny)
 ui <- fluidPage(
  fileInput(inputId = "up","", accept = '.csv'),
  uiOutput("sliders")
)

server <- function(input, output, session) {

  INPUT <- reactive({
    infile <- input$up
    if (is.null(infile))
      return(NULL)
    read.csv(infile$datapath, header = TRUE, sep = ",")
  })

 inVars <- reactive({
    unique(INPUT()$Big)
  })

  output$sliders <- renderUI({
    pvars <- length(inVars())
    if (pvars > 0) {
      div(
        lapply(seq(pvars), function(i) {
          numericInput(inputId = paste0("range", inVars()[i]),label = inVars()[i],value = 1)
        }),
        actionButton("getValues", "Get values"),
        tableOutput('table')
      )
    }
  })

  values <- 0

  # get the values of each numericInput and store them in "values"
  observeEvent(input$getValues, {
      # initialize vector 
      values <<- rep(NA, length(inVars()))
      names(values) <<- inVars()

      for(k in 1:length(inVars())) { 
        inputName <- paste0("range", inVars()[k])
        # only get a value if the numeric input exists
        if (!is.null(inputName))
          values[[k]] <<- input[[inputName]]
      }
    # show values as a table
    output$table <- renderTable(data.frame(
                        variable = inVars(),
                        values))

  })

}

shinyApp(ui = ui, server = server)

Update:

To test the code, use a .csv file with content like:

num,Big
1,a
2,a
3,b
4,b
5,c
6,c
7,d
8,d

Screenshot:

Dynamic number of Plots with reactive data in R Shiny

The following code generates dynamic number of outputs with iris data. You should be able to adapt this to your data.

  library(shiny)
  library(tidyverse)

  # Load data
  data("iris")

  # Add row id
  iris2 <- iris %>% mutate(ID = 1:n())

  # ui
  ui <- fluidPage(
    sidebarPanel(
      selectInput(inputId = "sel", label = "Select one or more parameters",
                  choices = names(iris2), multiple = TRUE)
    ),
    mainPanel(
      uiOutput("plots")
    )
  )

  # server
  server <- function(input, output, session){

    # Dynamically generate the plots based on the selected parameters
    observe({
      req(input$sel)
      lapply(input$sel, function(par){
        p <- ggplot(iris2, aes_string(x = "ID", y = par)) +
          geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
          ggtitle(paste("Plot: ", par)) 
        output[[paste("plot", par, sep = "_")]] <- renderPlot({
          p
        },
        width = 380,
        height = 350)
      })
    })

    # Create plot tag list
    output$plots <- renderUI({
      req(input$sel)
      plot_output_list <- lapply(input$sel, function(par) {
        plotname <- paste("plot", par, sep = "_")
        plotOutput(plotname, height = '250px', inline=TRUE)
      })

      do.call(tagList, plot_output_list)

    })

  }

  shinyApp(ui, server)

It gives the following output:

Shiny: Dynamic Number of Output Elements/Plots

Inspired from this, you could do:

ui.R

shinyUI(pageWithSidebar(            
        headerPanel("Dynamic number of plots"),            
        sidebarPanel(
                selectInput(inputId = "choosevar",
                            label = "Choose Cut Variable:",
                            choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
        ),            
        mainPanel(
                # This is the dynamic UI for the plots
                uiOutput("plots")
        )
))

server.R

library(googleVis)
shinyServer(function(input, output) {
        #dynamically create the right number of htmlOutput
        output$plots <- renderUI({
                plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
                        plotname <- paste0("plot", i)
                        htmlOutput(plotname)
                })

                tagList(plot_output_list)
        }) 

        # Call renderPlot for each one. Plots are only actually generated when they
        # are visible on the web page. 


        for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
                local({
                        my_i <- i
                        plotname <- paste0("plot", my_i)

                        output[[plotname]] <- renderGvis({
                                data <- mtcars[mtcars[,input$choosevar]==my_i,]
                                if(dim(data)[1]>0){
                                gvisColumnChart(    
                                        data, xvar='hp', yvar='mpg' 
                                )}
                                else NULL
                        })  
                })
        }

})

It basically creates htmlOutput plots dynamically and binds the googleVis plots when there is data in the subset.

R Shiny: create dynamic UI from selected input

In the description page of insertUI function, it says:

Unlike renderUI(), the UI generated with insertUI() is persistent:
once it's created, it stays there until removed by removeUI(). Each
new call to insertUI() creates more UI objects, in addition to the
ones already there (all independent from one another). To update a
part of the UI (ex: an input object), you must use the appropriate
render function or a customized reactive function.

So you cannot use insertUI here. Instead, use renderUI function with uiOutput to dynamically generate ui element.

Next, to generate a ui multiple times based on selection, you can use lapply. Since the number of iteration will be dependent on the number of items in the vector, which is the input$ object; the number of generated ui will be based on number of selection.

I think the code below solves your problem:

library(shiny)
library(shinyjs)

ui <- shinyUI(fluidPage(
  shinyjs::useShinyjs(),
  navbarPage("Test",id="navbarPage",
             tabPanel("First tab", id = "first_tab",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE), 
                          actionButton("set.covariates","Set"),
                          tags$hr(),
                          uiOutput("covariateop")
                        ),
                        mainPanel(
                          verbatimTextOutput("list")
                        )
                      )
             ))
))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
  
  observe({
    if (is.null(input$covariates) || input$covariates == "") {
      shinyjs::disable("set.covariates")
      
    } else {
      shinyjs::enable("set.covariates")
    }
  })
  
  observeEvent(input$set.covariates, {
    shinyjs::disable("set.covariates")
  })
  
  prep.list <- eventReactive(input$set.covariates,{
    cov <- input$covariates
    timeIndep.list <- NULL
    for(L0.i in seq_along(cov)){
      timeIndep.list[[L0.i]] <- list("categorical"=FALSE,
                                     "impute"=NA,
                                     "impute_default_level"=NA)
    }
    names(timeIndep.list) <- cov
    return(timeIndep.list)
  })
  
  output$list <- renderPrint({
    prep.list()
  })
  
  observeEvent(req(input$set.covariates), {
    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )})
  
  observeEvent(req(input$set.covariates), {
    output$covariateop <- renderUI({  
      lapply(input$covariates, function(x){
      
        tags$div(id = paste0("extra_criteria_for_", x),
                 h4(x),
                 selectInput("cov_1_class", "Covariate class",
                             choices = c("numeric","character")),
                 selectInput("cov_1_impute", "Impute",
                             choices = c("default","mean","mode","median")),
                 textInput("cov_1_impute_default_level", "Impute default level","0"),
                 tags$hr()
        )
      })
    })
    
  })
  
  observeEvent({input$covariates}, {
    removeUI(selector = '#extra_criteria')
  })
  
  
})

# Run the application
shinyApp(ui = ui, server = server)

---

Related Topics