Creating multiple numeric input according to the variables of an uploaded dataset

shiny

#1
library(shiny)
ui <- fluidPage(
  tabPanel("New Cases", icon=icon("edit"),
           sidebarLayout(
            sidebarPanel(width=3, #sidebarPanel "New Cases"
                        conditionalPanel(
                            'input.dataset02 === "Edit Table"',
                            textInput('NewID', HTML('<h5><b>Enter Name</b></h5>')), #Enter Factor?
                            numericInput('NewVal1', HTML('<h5><b>Enter Item</b></h5>'), NULL),
                            br(),
                            fluidRow(
                              column(2,  HTML('<h5><b>E14</b></h5>')),
                              column(4, numericInput("NewVal3", label = NULL, value = NULL)),
                              column(2, HTML('<h5><b>E16</b></h5>')), 
                              column(4, numericInput("NewVal4", label = NULL, value = NULL))
                            ),
                            fluidRow(
                              column(2, HTML('<h5><b>E18_1</b></h5>')),
                              column(4, numericInput("NewVal5", label = NULL, value = NULL)),
                              column(2,  HTML('<h5><b>E18</b></h5>')), 
                              column(4, numericInput("NewVal6", label = NULL, value = NULL))
                            ),
                            fluidRow(
                              column(2, HTML('<h5><b>FAEE</b></h5>')),
                              column(4, numericInput("NewVal7", label = NULL, value = NULL)),
                              column(2,  HTML('<h5><b>EtG</b></h5>')), 
                              column(4, numericInput("NewVal8", label = NULL, value = NULL))
                            ),
                            br(),
                            actionButton("goButton", "Update Table",icon("cloud-upload"), 
                                         style="width: 100%; height: 60px; color: steelblue; background-color: #337ab7; border-color: #2e6da4"),
                            br()
                          )),
             mainPanel(
               tabsetPanel(
                 id = 'dataset02',
                 tabPanel("Edit Table",
                          br(),
                          dataTableOutput("table3"))
                 ))
           )))
server <- function(input, output) {
  mydata3 = data.frame(Name=letters[NULL], Item=sample(NULL),Piece=sample(NULL), E14=sample(NULL), E16=sample(NULL), 
                       E18_1=sample(NULL), E18=sample(NULL), FAEE=sample(NULL), ETG=sample(NULL))
  output$table3 <- renderDataTable( df3())
  df3 <- eventReactive(input$goButton, {
    if(input$NewID!=" " && !is.null(input$NewVal1)
       && !is.null(input$NewVal3) && !is.null(input$NewVal4) && !is.null(input$NewVal5) 
       && !is.null(input$NewVal6) && !is.null(input$NewVal7) && !is.null(input$NewVal8) 
       && input$goButton>0)
      {
      newrow = data.frame(
        Name = input$NewID,
        Item = input$NewVal1,           
        Piece = 1,                      
        E14 = input$NewVal3,
        E16 = input$NewVal4,
        E18_1 = input$NewVal5,
        E18 = input$NewVal6,
        FAEE = input$NewVal7,
        ETG = input$NewVal8)
      mydata3 <<- rbind(mydata3, newrow)
    }
    mydata3
  }, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)

I am working on a Shiny app that allows the user to upload their own data and analyze them. At a certain point, I'd like to allow the user to introduce new data as numeric input and to build a new table including them.
I'd like my app to do it dynamically, i.e. creating a box in the sidebar panel containing new numeric input accordingly and with the name of the variables of my uploaded dataset.
I can do it by indicating a priori specific variables, but I'd like to make it dynamic.
I'd be really glad if somebody could attend to this matter. Here's included a simple example of my code and a screenshot showing how it looks like (but with a priori specified variables).

Screenshot of the app (in the "desired" format) is the following:


#2

This is my approach whenever I want to be able to dynamically add both input and output to my shiny apps. I have rewritten your app to dynamically create the ui in the sidebar panel and to use those inputs to create new observations. Here is the app:

library(shiny)
library(purrr)
ui <- fluidPage(
  tabPanel(
    "New Cases", icon=icon("edit"),
    sidebarLayout(
      sidebarPanel(
        width=3,
        uiOutput("dynamic_ui"),
        actionButton("goButton", "Update Table",icon("cloud-upload"), 
                     style="width: 100%; height: 60px; color: steelblue; background-color: #337ab7; border-color: #2e6da4")
      ),
      mainPanel(
        tabsetPanel(
          id = 'dataset02',
          tabPanel(
            "Edit Table",
            br(),
            dataTableOutput("table3")
          )
        )
      )
    )
  )
)
server <- function(input, output) {
  mydata3 = data.frame(Name=character(0), Item=integer(0),Piece=integer(0), E14=integer(0), E16=integer(0), 
                       E18_1=integer(0), E18=integer(0), FAEE=integer(0), ETG=integer(0))
  output$table3 <- renderDataTable( df3())
  
  output$dynamic_ui <- renderUI({
    req(mydata3)
    
    my_cols <- colnames(mydata3)
    
    ui_elems <- purrr::map(my_cols, ~{
      if (class(mydata3[[.x]]) %in% c("factor", "character")){
        output <- textInput(
          inputId = paste("input", .x, sep = "_"),
          label = .x,
          value = NULL
        )
      } else if (class(mydata3[[.x]]) %in% c("integer", "numeric")){
        output <- numericInput(
          inputId = paste("input", .x, sep = "_"),
          label = .x,
          value = NULL
        )
      } else output <- NULL
      
      return(output)
    })
    
    return(tagList(ui_elems))
  })
  
  df3 <- eventReactive(input$goButton, {
    my_cols <- colnames(mydata3)
    my_inputs <- paste("input", my_cols, sep = "_")
  
    req(mydata3)
    walk(my_inputs, ~req(input[[.x]]))
    
    new_data <- purrr::map2_dfc(
      my_cols, 
      my_inputs,
      ~{
        output <- data.frame(input[[.y]])
        colnames(output) <- .x
        
        return(output)
      }
    )

    
   mydata3 <<- rbind(mydata3, new_data)
    
    mydata3
  }, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)

So I made some fairly drastic changes to your app so bear with me while I walk through them:

  1. I moved all of the ui elements (except the actionButton into the server code). This can be found in the output$dynamic_ui <- renderUI() section.
  2. I dynamically create the all of the input in that renderUI call by first collecting the column names of the dataset being used and then iterating over them using purrr::map. This will create a list of ui input elements. In order to pass them successfully into the ui code, you need to wrap it in tagList (as can be seen at the end of this chunk as return(tagList(ui_elems)).
  3. I changed your eventReactive expression in two ways. First, I changed the way that you do you element checking by using a combination of req and purrr::walk. Using the column names and the input[["input_id"]] subsetting method, I can generate the input ids and make sure that they are there before anything changes in the datatable. Second I changed your definition of the new row of data to use purrr::map2_dfc. This function iterates over two lists (or vectors) of the same length and then instead of returning a list of the outputs, it returns a data frame with all of the elements bound by column (same as cbind or bind_cols).
  4. I changed the definition of mydata3 so that column class would be explicit as what type of input you want will have to vary based on this. This would work when users upload their own data too.

In terms of letting users dynamically upload datasets and add to them, you would use fileInput and then create a reactive object that represents the dataset. Then you would simply need to change all of the mydata3 calls in your server code to the name of your reactive object (and don't forget that reactive objects have to be called like functions with parenthesis after them).


#3

Dear @tbradley, thank you so much for your very quick and comprehensive reply! The code nonw is consistently better and works pretty well! Thank you very much!
By the way, I still have a few issues I hope you have time to solve for this code.

1 - You correctly suggested my to use fileInput instead of mydata3 to make the app dynamic according to the uploaded dataset, but I don't know how to type the section

 mydata3 = data.frame(Name=character(0), Item=integer(0),Piece=integer(0), E14=integer(0), E16=integer(0), 
                       E18_1=integer(0), E18=integer(0), FAEE=integer(0), ETG=integer(0))

in order to create a dynamic table with dynamic header equals to the header of my uploaded dataset.

2-I'd like to input a new subject (e.g. "John Doe") even if I have not the results for all the markers (e.g. even in case id, for instance, EtG is missing), do I have to remove else output <- NULL from the code?
Thank you very very much again for your willingness and availability


#4

If the user uploads the a file (e.g. a csv file) then you don't need to define mydata3 at the beginning. Just use the data that is uploaded. If there are any values in the data that is uploaded than they will have a class in R. The else output <- NULL just makes it so that no ui element is created for columns that are not either character or numeric. Although you could certainly add more logic to include other expected column types.

If you did not want to require that the all columns have to be filled than you should remove the walk(my_inputs, ~req(input[[.x]])) line. This line makes it so that all of the inputs have to be non-NULL values before anything after it in the reactive expression will be executed


#5

Dear @tbradley, thank you very much again for your reply. I'm sorry to keep on bothering you with this, I tried to follow your advices but I can't modify the app in order to make it dynamic to an uploaded dataset.
Here is my renewed code, but it doesn't work when I upload some data, i.e. no numeric input appears.
Could you please attend again to this matter? Thank you very much again for your availability.

library(shiny)
library(purrr)
ui <- fluidPage(
  tabPanel(
    "New Cases", icon=icon("edit"),
    sidebarLayout(
      sidebarPanel(
        width=3,
        fileInput('file1', 'Choose CSV File', accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
        uiOutput("dynamic_ui"),
        actionButton("goButton", "Update Table",icon("cloud-upload"), 
                     style="width: 100%; height: 60px; color: steelblue; background-color: #337ab7; border-color: #2e6da4")
      ),
      mainPanel(
        tabsetPanel(
          id = 'dataset02',
          tabPanel(
            "Edit Table",
            br(),
            dataTableOutput("table3")
          )
        )
      )
    )
  )
)
server <- function(input, output) {
  data_set <- reactive({
    inFile <- input$file1
    
    if (is.null(inFile))
      return(NULL)
    
    data_set<-read.table(inFile$datapath,header = FALSE)
  })
  # mydata3 = data.frame(Name=character(0), Item=integer(0),Piece=integer(0), E14=integer(0), E16=integer(0), 
  #                      E18_1=integer(0), E18=integer(0), FAEE=integer(0), ETG=integer(0))
  output$table3 <- renderDataTable( df3())
  
  output$dynamic_ui <- renderUI({
    req(data_set)
    
    my_cols <- colnames(data_set)
    
    ui_elems <- purrr::map(my_cols, ~{
      if (class(data_set[[.x]]) %in% c("factor", "character")){
        output <- textInput(
          inputId = paste("input", .x, sep = "_"),
          label = .x,
          value = NULL
        )
      } else if (class(data_set[[.x]]) %in% c("integer", "numeric")){
        output <- numericInput(
          inputId = paste("input", .x, sep = "_"),
          label = .x,
          value = NULL
        )
      } else output <- NULL
      
      return(output)
    })
    
    return(tagList(ui_elems))
  })
  
  df3 <- eventReactive(input$goButton, {
    my_cols <- colnames(data_set)
    my_inputs <- paste("input", my_cols, sep = "_")
    
    req(data_set)
    walk(my_inputs, ~req(input[[.x]]))
    
    new_data <- purrr::map2_dfc(
      my_cols, 
      my_inputs,
      ~{
        output <- data.frame(input[[.y]])
        colnames(output) <- .x
        
        return(output)
      }
    )
    
    
    data_set <<- rbind(data_set, new_data)
    
    data_set
  }, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)

#6

Ok, so your underlying issue in your current server code is that you are calling the reactive expression without the parenthesis, which is resulting in a non-existent object being used, hence no inputs being created.

However, when I corrected this issue, a new problem arose. That being that you can not use the <<- operator on reactive expressions (and it is typically discouraged in general due to unforeseen consequences). Changing the way that it appended the new data to the original dataset brought up another issue that if you tried to just bind to the original data set, only the newest addition was kept. Trying to append it to itself if it wasn't the first added row caused an infinite loop. So, long story short, to get around that I create a temp file that stores all the added values from a given session and then every time a new row is added, it is appended to this temp csv and then all the new rows (from a given session) are appended to the original data.

Here is the code:

server <- function(input, output, session) {
  data_set <- reactive({
    inFile <- input$file1
    
    if (is.null(inFile))
      return(NULL)
    
    data_set<-readr::read_csv(inFile$datapath)
  })
  # mydata3 = data.frame(Name=character(0), Item=integer(0),Piece=integer(0), E14=integer(0), E16=integer(0), 
  #                      E18_1=integer(0), E18=integer(0), FAEE=integer(0), ETG=integer(0))
  
  output$table3 <- renderDataTable({
    if (input$goButton == 0) {
      data_set()
    } else df3()
  })
  
  output$dynamic_ui <- renderUI({
    req(data_set())
    
    my_cols <- colnames(data_set())
    
    ui_elems <- purrr::map(my_cols, ~{
      if (class(data_set()[[.x]]) %in% c("factor", "character")){
        output <- textInput(
          inputId = paste("input", .x, sep = "_"),
          label = .x,
          value = NULL
        )
      } else if (class(data_set()[[.x]]) %in% c("integer", "numeric")){
        output <- numericInput(
          inputId = paste("input", .x, sep = "_"),
          label = .x,
          value = NULL
        )
      } else output <- NULL
      
      return(output)
    })
    
    return(tagList(ui_elems))
  })
  
  temp_file <- tempfile(fileext = ".csv")
  
  df3 <- eventReactive(input$goButton, {
    my_cols <- colnames(data_set())
    my_inputs <- paste("input", my_cols, sep = "_")
    
    req(data_set())
    walk(my_inputs, ~req(input[[.x]]))
    
    
    
    new_data <- purrr::map2_dfc(
      my_cols, 
      my_inputs,
      ~{
        output <- data.frame(input[[.y]])
        colnames(output) <- .x
        
        return(output)
      }
    )
    
    if (file.exists(temp_file)) {
      old_entries <- readr::read_csv(temp_file)
      
      new_data <- rbind(old_entries, new_data)
    }
    
    write_csv(new_data, temp_file)
    
    
    output <- rbind(data_set(), new_data)
    
    
    return(output)
  }, ignoreNULL = FALSE)
  
  session$onSessionEnded(function(){
    file.remove(temp_file)
    stopApp()
  })
}

Some additional things:

  1. I added a session argument to your server function so that I could add the session$onSessionEnded function which does two things. first, it deletes that temp file and second it ends the shiny session when the app is closed.
  2. I changed the way the your data is loaded from the selected file from base read.table to readr::read_csv. read_csv has desirable attributes regarding the class that is assigned to each column. Also, the header=FALSE argument is counterproductive to your goal as you want the column names to be recognized as columns in this case (since we are using the column names later on).
  3. You will need to load readr at the top of your script by adding library(readr)

#7

One more thing to note, this app will likely fail if a user tries to upload a file, make changes and then try to upload a new file.

I would suggest trying to find a way to address this issue or advising users to refresh their app when they want to load a new dataset


#8

Dear @tbradley, thanks a lot for all the modifications and the advices! The app looks perfect now and you solved all my issues. I hope I didn't waste too much of your time!
Thank you very very much!