Search code examples
rshiny

How to upload and process all specified Shiny inputs simultaneously when accessing previously downloaded inputs?

The simplified code below allows the user to download ("Save") user inputs and retrieve them later using an Upload action button. The image below shows how this App works. The problem is that there are two input variables that interact: time_window from the sliderInput() and the user's inputs into the 2-column input matrix called matInput(). If the user has saved the inputs, and in another session for example has the time_window set at 5, and tries retrieving the saved scenario where time_window had been set at 10, it takes 2 clicks of the Upload action button to retrieve that saved scenario: the first click retrieves the sliderInput() value of 10 from the saved scenario and the second click retrieves the values in the matInput() objects that was saved. You can see in the code where in the downloadHander() I group the two inputs as saveRDS(list(var_1_input = input$var_1_input, time_window = input$time_window) and in the observe() for upload I group these inputs together as updateSliderInput(session, "time_window", value = uploaded_values$time_window) updateMatrixInput(session, "var_1_input", value = uploaded_values$var_1_input); but this doesn't work to simultaneously retrieve and process the inputs.

So, when uploading saved inputs, how can they be accessed and processed simultaneously with one single click of an action button?

enter image description here

Code:

library(shiny)
library(shinyMatrix)

matInput <- function(name, x) {
  matrixInput(
    name,
    value = matrix(c(x, 0), 1, 2, dimnames = list(NULL, c("X", "Y"))),
    rows = list(extend = TRUE, names = FALSE),
    cols = list(extend = TRUE, delta = 0, names = TRUE, editableNames = FALSE),
    class = "numeric"
  )
}

matStretch <- function(mat, time_window, col_name) {
  mat[, 1] <- pmin(mat[, 1], time_window)
  df <- data.frame(matrix(0, nrow = time_window, ncol = 1, dimnames = list(NULL, col_name)))
  df[, col_name] <- ifelse(seq_along(df[, 1]) %in% mat[, 1], mat[match(seq_along(df[, 1]), mat[, 1]), 2], 0)
  return(df)
}

ui <- fluidPage(
  actionButton('modal_upload', 'Upload'),
  downloadButton("save_btn", "Save"),
  sliderInput("time_window","Time window (W):", min = 1, max = 10, value = 10),
  uiOutput("Vectors"),
  tableOutput("table2")
)

server <- function(input, output, session) {
  time_window <- reactive(input$time_window)
  output$Vectors <- renderUI({matInput("var_1_input", input$time_window)})
  
  output$save_btn <- downloadHandler(
    filename = function() paste0("scenario", ".rds"),
    content = function(file) saveRDS(list(var_1_input = input$var_1_input, time_window = input$time_window), file)
  )
  
  observeEvent(input$modal_upload, {
    showModal(modalDialog(fileInput("upload_file_input", "Upload:", accept = c('.rds'))))
  })
  
  observe({
    if (!is.null(input$upload_file_input)) {
      uploaded_values <- readRDS(input$upload_file_input$datapath)
      updateSliderInput(session, "time_window", value = uploaded_values$time_window)
      updateMatrixInput(session, "var_1_input", value = uploaded_values$var_1_input)
      removeModal()
    }
  })
  
  var_1 <- reactive(input$var_1_input)
  output$table2 <- renderTable(matStretch(var_1(), time_window(), "Var_1"))
}

shinyApp(ui, server)
Solution

  • A more direct approach for the server code to ensure the output$ variables are not overwritten by subsequent reactives:

    server <- function(input, output, session) {
  output$Vectors <- renderUI({matInput("var_1_input", input$time_window)})
  
  output$save_btn <- downloadHandler(
    filename = function() paste0("scenario", ".rds"),
    content = function(file) saveRDS(list(var_1_input = input$var_1_input, time_window = input$time_window), file)
  )
  
  observeEvent(input$modal_upload, {
    showModal(modalDialog(fileInput("upload_file_input", "Upload:", accept = c('.rds'))))
  })
  
  observe({
    if (!is.null(input$upload_file_input)) {
      uploaded_values <- readRDS(input$upload_file_input$datapath)
      updateSliderInput(session, "time_window", value = uploaded_values$time_window)
      updateMatrixInput(session, "var_1_input", value = uploaded_values$var_1_input)
      output$Vectors <- renderUI({matInput("var_1_input", uploaded_values$time_window)})
      output$table2 <- renderTable(matStretch(uploaded_values$var_1_input, uploaded_values$time_window, "Var_1"))
      removeModal()
    }
  })
  
  output$table2 <- renderTable(matStretch(input$var_1_input, input$time_window, "Var_1"))
}