r – Loop over LAPPLY with LAPPLY in a SHINY app

I have the following App.

This app allows me to dynamically add fields, then populate a report.

I am having problems trying to create functions that will make it less verbose.

In particular, I want to capture the result of dynamically created UI inputs.

The following code runs just fine, but will be hard to expand beyond more than a few inputs (input$med_hx and input$surg_hx)

library(shiny)
library(shinythemes)
library(shiny)

line_double <- paste(rep("═", 54), collapse = "")
line_single <- paste(rep("─", 54), collapse = "")
line_short_dash <- paste(rep("-", 125), collapse = "")
bullet <- "•"
r_arrow <- "→"



ui <- fluidPage(
  
  theme = shinytheme("readable"),
  
  titlePanel("VP report generator"), 
  
  
  tabsetPanel(
    tabPanel("Inputs",   
             textAreaInput("indication", 
                           "Tell us about yourself", 
                           width = "600px", 
                           height = "70px", 
                           value = "")
    ), 
    
    tabPanel("Med Surg",
             tabsetPanel(
               tabPanel("MedHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "med_hx", 
                                              label = "Number of Medical Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10), 
                                 uiOutput("UI_med_hx")
                          )
                        )
               ),
               tabPanel("SurgHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "surg_hx", 
                                              label = "Number of Surgical Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10),
                                 uiOutput("UI_surg_hx")
                          ) 
                        )
               )
             )
    ), #Close inner tabsetPanel
    
    tabPanel("OBGYN",
             tabsetPanel(
               tabPanel("OBHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "ob_hx", 
                                              label = "Number of Ob Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10)
                          )
                        )
               ),
               tabPanel("GynHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "gyn_hx", 
                                              label = "Number of Gyn Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10)
                          ) 
                        )
               )
             ) 
    ), 
    tabPanel("Report",
             htmlOutput("text", width="50px")
    )
  )
)



server <- function(input, output, session) {
  
  
  
  fn_renderUI <- function(x, j){
    
    # x is the input
    # j is the name of the new input to make
    
    shiny::req(x > 0)
    
    tagList(
      
      lapply(1:x, function(y){
        
        fluidRow(
          column(3, 
                 textInput(
                   paste(j, y, sep = "_"), 
                   y, 
                   value = ""
                 )
          )
          
        )
        
      })
      
    )
    
    
    
  }
  
  myinputs <- c("med_hx", "surg_hx")
  
  lapply(myinputs, function(i){
    
    
    output[[paste0("UI_", i)]] <- renderUI({
      
      fn_renderUI(
        x = input[[i]],
        j = paste0(i, "_section")
      )
      
    }
    )
    
    
  })
  
  
  
  
  text_df <- reactive({
    
    myinputs <- c("med_hx", "surg_hx")
    
    d <- data.frame(text = rep("", 100))
    
    # the indication must always go in the first spot (top of the report)
    
    if(input$indication != ""){
      d$text[1] <- paste(line_double,
                         input$indication,
                         line_double,
                         sep = "</br>")
    }
    
    
    
    # HERE IS THE SECTION I AM GETTIN HUNG UP ON 
    # I AM TRYING TO LOOP THROUGH THE NEW UI INPUTS (RATHER THAN WRITE EACH OF THEM OUT OVER AND OVER)
    # THE CODE BELOW THIS IS HOW I PERFORMED THIS TASK PREVIOUSLY, BUT I DON'T WANT TO WRITE EVERYTHING OUT EACH TIME.
    
    # lapply(myinputs, function(x){
    #   
    #   if(input[[x]]>0){
    #     
    #     assign(paste0("dynamic_UIs_", x),
    #            
    #            lapply(1:input[[x]], function(y){
    #              
    #              input[[paste0(x, "_section_", y)]]
    #              
    #            })
    #            
    #     )
    #   }
    #   
    # })
    
    
    
    #Grab each of the inputs 
    
    if(input$med_hx >0){
      dynamic_UIs_med_hx <-lapply(1:input$med_hx, function(x){

        input[[paste0("med_hx_section_",x)]]



      })
    
    

    
    
    
    
    
    # add med/surg history
    
    if(length(dynamic_UIs_med_hx > 0)){
      
      dynamic_UIs_med_hx <- dynamic_UIs_med_hx[dynamic_UIs_med_hx != ""]
      dynamic_UIs_med_hx <- paste0("• ", paste(dynamic_UIs_med_hx, collapse = "</br>• "))
      
      
      
      d$text[2] <- paste(
        "med_hx",
        line_short_dash,
        dynamic_UIs_med_hx, 
        sep = "</br>"
      ) 
      
      
    }
    }
    
    if(input$surg_hx > 0){
      dynamic_UIs_surg_hx <-lapply(1:input$surg_hx, function(x){

        input[[paste0("surg_hx_section_",x)]]



      })
    
    if(length(dynamic_UIs_surg_hx > 0)){
      
      dynamic_UIs_surg_hx <- dynamic_UIs_surg_hx[dynamic_UIs_surg_hx != ""]
      dynamic_UIs_surg_hx <- paste0("• ", paste(dynamic_UIs_surg_hx, collapse = "</br>• "))
      
      
      
      d$text[3] <- paste(
        "surg_hx",
        line_short_dash,
        dynamic_UIs_surg_hx,
        sep = "</br>"
      )
      
      
    }
    
    }
    
    #d <- d[d$text != "", "text"]
    return(d)
    
  })
  
  
  
  
  output$text  <- renderUI({
    
    
    HTML(
      paste(
        
        text_df()$text, 
        collapse = "</br></br>"
        
        
      )
    )
    
    
    
  })
  
  
  
}
shinyApp(ui, server)






This code below is my attempt to loop over inputs to make it read more easily. Can anyone help me at the lapply within the lapply in the server section? Can’t seem to get it to work.

I keep getting the following Error: object ‘dynamic_UIs_med_hx’ not found

library(shiny)
library(shinythemes)
library(shiny)

line_double <- paste(rep("═", 54), collapse = "")
line_single <- paste(rep("─", 54), collapse = "")
line_short_dash <- paste(rep("-", 125), collapse = "")
bullet <- "•"
r_arrow <- "→"



ui <- fluidPage(
  
  theme = shinytheme("readable"),
  
  titlePanel("VP report generator"), 
  
  
  tabsetPanel(
    tabPanel("Inputs",   
             textAreaInput("indication", 
                           "Tell us about yourself", 
                           width = "600px", 
                           height = "70px", 
                           value = "")
    ), 
    
    tabPanel("Med Surg",
             tabsetPanel(
               tabPanel("MedHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "med_hx", 
                                              label = "Number of Medical Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10), 
                                 uiOutput("UI_med_hx")
                          )
                        )
               ),
               tabPanel("SurgHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "surg_hx", 
                                              label = "Number of Surgical Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10),
                                 uiOutput("UI_surg_hx")
                          ) 
                        )
               )
             )
    ), #Close inner tabsetPanel
    
    tabPanel("OBGYN",
             tabsetPanel(
               tabPanel("OBHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "ob_hx", 
                                              label = "Number of Ob Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10)
                          )
                        )
               ),
               tabPanel("GynHx",
                        fluidRow(
                          column(width = 6,
                                 numericInput(inputId = "gyn_hx", 
                                              label = "Number of Gyn Conditions", 
                                              value = 0, 
                                              min = 0, 
                                              max = 10)
                          ) 
                        )
               )
             ) 
    ), 
    tabPanel("Report",
             htmlOutput("text", width="50px")
    )
  )
)



server <- function(input, output, session) {
  
  
  
  fn_renderUI <- function(x, j){
    
    # x is the input
    # j is the name of the new input to make
    
    shiny::req(x > 0)
    
    tagList(
      
      lapply(1:x, function(y){
        
        fluidRow(
          column(3, 
                 textInput(
                   paste(j, y, sep = "_"), 
                   y, 
                   value = ""
                 )
          )
          
        )
        
      })
      
    )
    
    
    
  }
  
  myinputs <- c("med_hx", "surg_hx")
  
  lapply(myinputs, function(i){
    
    
    output[[paste0("UI_", i)]] <- renderUI({
      
      fn_renderUI(
        x = input[[i]],
        j = paste0(i, "_section")
      )
      
    }
    )
    
    
  })
  
  
  
  
  text_df <- reactive({
    
    myinputs <- c("med_hx", "surg_hx")
    
    d <- data.frame(text = rep("", 100))
    
    # the indication must always go in the first spot (top of the report)
    
    if(input$indication != ""){
      d$text[1] <- paste(line_double,
                         input$indication,
                         line_double,
                         sep = "</br>")
    }
    
    
    
    # HERE IS THE SECTION I AM GETTIN HUNG UP ON 
    # I AM TRYING TO LOOP THROUGH THE NEW UI INPUTS (RATHER THAN WRITE EACH OF THEM OUT OVER AND OVER)
    # THE CODE BELOW THIS IS HOW I PERFORMED THIS TASK PREVIOUSLY, BUT I DON'T WANT TO WRITE EVERYTHING OUT EACH TIME.
    
    lapply(myinputs, function(x){

      if(input[[x]]>0){

        assign(paste0("dynamic_UIs_", x),

               lapply(1:input[[x]], function(y){

                 input[[paste0(x, "_section_", y)]]

               })

        )
      }

    })
    
    
    
    #Grab each of the inputs 
    
    # if(input$med_hx >0){
    #   dynamic_UIs_med_hx <-lapply(1:input$med_hx, function(x){
    # 
    #     input[[paste0("med_hx_section_",x)]]
    # 
    # 
    # 
    #   })
    
    
    # add med/surg history
    
    if(length(dynamic_UIs_med_hx > 0)){
      
      dynamic_UIs_med_hx <- dynamic_UIs_med_hx[dynamic_UIs_med_hx != ""]
      dynamic_UIs_med_hx <- paste0("• ", paste(dynamic_UIs_med_hx, collapse = "</br>• "))
      
      
      
      d$text[2] <- paste(
        "med_hx",
        line_short_dash,
        dynamic_UIs_med_hx, 
        sep = "</br>"
      ) 
      
      
    }
   # }
    
    # if(input$surg_hx > 0){
    #   dynamic_UIs_surg_hx <-lapply(1:input$surg_hx, function(x){
    # 
    #     input[[paste0("surg_hx_section_",x)]]
    # 
    # 
    # 
    #   })
    
    if(length(dynamic_UIs_surg_hx > 0)){
      
      dynamic_UIs_surg_hx <- dynamic_UIs_surg_hx[dynamic_UIs_surg_hx != ""]
      dynamic_UIs_surg_hx <- paste0("• ", paste(dynamic_UIs_surg_hx, collapse = "</br>• "))
      
      
      
      d$text[3] <- paste(
        "surg_hx",
        line_short_dash,
        dynamic_UIs_surg_hx,
        sep = "</br>"
      )
      
      
    }
    
  #  }
    
    #d <- d[d$text != "", "text"]
    return(d)
    
  })
  
  
  
  
  output$text  <- renderUI({
    
    
    HTML(
      paste(
        
        text_df()$text, 
        collapse = "</br></br>"
        
        
      )
    )
    
    
    
  })
  
  
  
}
shinyApp(ui, server)






Thanks

Leave a Comment