Collect All User Inputs Throughout the Shiny App

Collect current user inputs and ignore/remove the previous inputs using R Shiny

Created inputs are not deleted when a new renderUI is called, so there is no solution this way.

A workaround is to use a counter (like the one previously used to create the input) and use it to rebuild the names:

AllInputs <- reactive({
    num <- as.integer( input$nbox )
    my_names <- paste0("textBox", 1:num)
    all_values <- stack( reactiveValuesToList(input) )
    myvalues <- all_values[ all_values$ind %in% c("nbox", my_names), 
                            c(2, 1)]
    names(myvalues) <- c("User input variable","User input value")
    myvalues
})

Note the use of reactiveValuesToList to replace the loop.

Export all user inputs in a Shiny app to file and load them later

If you look at the code of the shiny input update functions, they end by session$sendInputMessage(inputId, message). message is a list of attributes that need to be changed in the input, for ex, for a checkbox input: message <- dropNulls(list(label = label, value = value))

Since most of the input have the value attribute, you can just use the session$sendInputMessage function directly on all of them without the try.

Here's an example, I created dummy_data to update all the inputs when you click on the button, the structure should be similar to what you export:

ui.R

library(shiny)
shinyUI(fluidPage(
  textInput("control_label",
            "This controls some of the labels:",
            "LABEL TEXT"),
  numericInput("inNumber", "Number input:",
               min = 1, max = 20, value = 5, step = 0.5),
  radioButtons("inRadio", "Radio buttons:",
               c("label 1" = "option1",
                 "label 2" = "option2",
                 "label 3" = "option3")),
  actionButton("update_data", "Update")

  ))

server.R

library(shiny)

dummy_data <- c("inRadio=option2","inNumber=10","control_label=Updated TEXT" )

shinyServer(function(input, output,session) {
  observeEvent(input$update_data,{    
    out <- lapply(dummy_data, function(l) unlist(strsplit(l, "="))) 
   for (inpt in out) {
     session$sendInputMessage(inpt[1], list(value=inpt[2]))
    }
   })

})

All the update functions also preformat the value before calling session$sendInputMessage. I haven't tried all possible inputs but at least for these 3 you can pass a string to the function to change the numericInput and it still works fine.

If this is an issue for some of your inputs, you might want to save reactiveValuesToList(input) using save, and when you want to update your inputs, use load and run the list in the for loop (you'll have to adapt it to a named list).

R Shiny: How to display 'almost' all input values

This could be achieved by adjusting your reactive AllInputs like so:

1. I add a vector id_exclude of input ids which should be excluded from the table
2. I add a vector id_include as the difference between all inputs and the ids to exclude
3. I also added an if condition to check if id_include contains any elements because otherwise one gets an error when starting the app.

      AllInputs <- reactive({
        id_exclude <- c("savebutton")
        
        id_include <- setdiff(names(input), id_exclude)
        
        if (length(id_include) > 0) {
          myvalues <- NULL
          for(i in id_include) {
            myvalues <- as.data.frame(rbind(myvalues, cbind(i, input[[i]])))
          }
          names(myvalues) <- c("Variable", "Selected Value")
          myvalues
        }
      })

R Shiny, - Passing Multiple User Inputs into a single dataframe in server

I know answers are usually supposed to solve your specific problem but I am quite lazy to type all those defaults, you can do this with editable data frames, I like to use the DT package for this

example based on:https://yihui.shinyapps.io/DT-edit/

library(shiny)
library(DT)

dt_output = function(title, id) {
  fluidRow(column(
    12, h1(paste0('Table ', sub('.*?([0-9]+)$', '\\1', id), ': ', title)),
    hr(), DTOutput(id)
  ))
}
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
  renderDT(data, selection = 'none', server = server, editable = editable, ...)
}

shinyApp(
  ui = fluidPage(
    title = 'Double-click to edit table rows',
    
    dt_output('server-side processing (editable = "row")', 'x6'),
  ),
  
  server = function(input, output, session) {
    d6 = iris
    d6$Date = Sys.time() + seq_len(nrow(d6))
    
    options(DT.options = list(pageLength = 5))
    
    # server-side processing
    output$x6 = render_dt(d6, 'row')
    
    # edit a row
    observeEvent(input$x6_cell_edit, {
      d6 <<- editData(d6, input$x6_cell_edit, 'x6')
    })
    
})

In R Shiny, how to read additional user inputs into a function and plot the results?

Edit: I'd suggest using a row-based matrixInput. This makes your life much easier, as you don't have to reshape the matrix before passing it to your custom function etc.

Please check the following:

library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)

interpol <- function(a, b) {
  # a = periods, b = matrix inputs
  c <- rep(NA, a)
  c[1] <- b[1]
  c[a] <- b[2]
  c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # this interpolates
  return(c)
}

ui <- fluidPage(
  titlePanel("myMatrixInput"),
  sidebarLayout(
    sidebarPanel(
      matrixInput(
        "myMatrixInput",
        label = "Values to interpolate (myMatrixInput) where first row lists scenario number:",
        value =  matrix(c(10, 1, 5), 1, 3, dimnames = list("Scenario 1", c("Periods", "Value 1", "Value 2"))),
        cols = list(
          extend = FALSE,
          names = TRUE, 
          editableNames = FALSE
        ),
        rows = list(names = TRUE,
                    delete = TRUE,
                    extend = TRUE,
                    delta = 1),
        class = "numeric"
      ),
      actionButton("add", "Add scenario")
    ),
    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  
  sanitizedMat <- reactiveVal()
  
  observeEvent(input$myMatrixInput, {
    if(any(rownames(input$myMatrixInput) == "")){
      tmpMatrix <- input$myMatrixInput
      rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
      updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
    }
    sanitizedMat(na.omit(input$myMatrixInput))
  })
  
  plotData <- reactive({
    req(dim(sanitizedMat())[1] >= 1)

    lapply(seq_len(nrow(sanitizedMat())),
                function(i){
                  tibble(
                    Scenario = rownames(sanitizedMat())[i],
                    X = seq_len(sanitizedMat()[i, 1]),
                    Y = interpol(sanitizedMat()[i, 1], sanitizedMat()[i, 2:3])
                  )
                }) %>% bind_rows()
  })

  output$plot <- renderPlot({
    req(nrow(plotData()) > 0)
    plotData() %>% ggplot() + geom_line(aes(
      x = X,
      y = Y,
      colour = as.factor(Scenario)
    ))
  })
}

shinyApp(ui, server)

---

Initial Answer

There is no need to calulate the numScenarios as they are defined by the dimensions of your matrix. The same applies to the modal you'll add later - just monitor the dimensions of the data to change the plot - no matter which input changes the reactive dataset.

As a general advice I'd recommend working with data.frames in long format instead of a matrix to prepare plots (using e.g. ggplot or plotly). See my answer here for an example.

Please check the following:

library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)

interpol <- function(a, b) {
  # a = periods, b = matrix inputs
  c <- rep(NA, a)
  c[1] <- b[1]
  c[a] <- b[2]
  c <- approx(seq_along(c)[!is.na(c)], c[!is.na(c)], seq_along(c))$y # this interpolates
  return(c)
}

ui <- fluidPage(
  sliderInput(
    'mySliderInput',
    'Periods to interpolate (mySliderInput):',
    min = 2,
    max = 10,
    value = 10
  ),
  matrixInput(
    "myMatrixInput",
    label = "Values to interpolate (myMatrixInput):",
    value =  matrix(c(1, 5), 1, 2, dimnames = list(NULL, c("Value 1", "Value 2"))),
    cols = list(
      extend = TRUE,
      delta = 2,
      delete = TRUE
    ),
    rows =  list(names = FALSE),
    class = "numeric"
  ),
  actionButton("add", "Add scenario"),
  plotOutput("plot")
)

server <- function(input, output, session) {
  
  observeEvent(input$add, {
    showModal(modalDialog(footer = modalButton("Close")))
  })
  
  plotData <- reactive({
    req(dim(input$myMatrixInput)[2] >= 2)
    # req(dim(input$myMatrixInput)[2]%%2 == 0)
    req(input$mySliderInput)
    
    
    if(as.logical(dim(input$myMatrixInput)[2]%%2)){
      myVector <- head(as.vector(input$myMatrixInput), -1)
    } else {
      myVector <- as.vector(input$myMatrixInput)
    }
    
    myMatrix <- matrix(myVector, ncol = 2)
    
    lapply(seq_len(length(myVector)/2),
                function(i){
                  tibble(
                    Scenario = i,
                    X = seq_len(input$mySliderInput),
                    Y = interpol(req(input$mySliderInput), req(myMatrix[i,]))
                  ) 
                }) %>% bind_rows()
  })
  
  output$plot <- renderPlot({
    req(nrow(plotData()) > 0)
    plotData() %>% ggplot() + geom_line(aes(
      x = X,
      y = Y,
      colour = as.factor(Scenario)
    ))
  })
}

shinyApp(ui, server)

The above Edit works BEAUTIFULLY. Wow. Now the below simple edit of your edit simply pull the periods to interpolate out of the input matrix and back into a single slider input since in the full model this is meant for, modeled periods have to be the same for all input variables. However your 3 column matrix inputs also help me on another matter so THANK YOU. Also, I removed the "Add scenarios" action button since it is no longer needed with the automatically expanding input matrix. I sure learned a lot with this.

Edit of your edit:

ui <- fluidPage(
  titlePanel("myMatrixInput"),
  sidebarLayout(
    sidebarPanel(
      sliderInput('periods','Periods to interpolate:',min=2,max=10,value=10),
      matrixInput(
        "myMatrixInput",
        label = "Values to interpolate (myMatrixInput):",
        value =  matrix(c(1, 5), 1, 2, dimnames = list("Scenario 1", c("Value 1", "Value 2"))),
        cols = list(extend = FALSE,
                    names = TRUE, 
                    editableNames = FALSE),
        rows = list(names = TRUE,
                    delete = TRUE,
                    extend = TRUE,
                    delta = 1),
        class = "numeric"
      ),
    ),
    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  
  sanitizedMat <- reactiveVal()
  
  observeEvent(input$myMatrixInput, {
    if(any(rownames(input$myMatrixInput) == "")){
      tmpMatrix <- input$myMatrixInput
      rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
      updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
    }
    sanitizedMat(na.omit(input$myMatrixInput))
  })
  
  plotData <- reactive({
    req(dim(sanitizedMat())[1] >= 1)
    lapply(seq_len(nrow(sanitizedMat())),
           function(i){
             tibble(
               Scenario = rownames(sanitizedMat())[i],
               X = 1:input$periods,
               Y = interpol(input$periods, sanitizedMat()[i, 1:2])
             )
           }) %>% bind_rows()
  })
  
  output$plot <- renderPlot({
    req(nrow(plotData()) > 0)
    plotData() %>% ggplot() + geom_line(aes(
      x = X,
      y = Y,
      colour = as.factor(Scenario)
    ))
  })
}

shinyApp(ui, server)

Shiny: Getting a user input into a future function

I solved it. Not enterily sure why, but isolate does the trick.
This code works for me:

library(shiny)
library(promises)
library(future)

plan(multisession)

# example function
subfct = function(n) {
  Sys.sleep(3)
  return(n*2)
}

# shiny page
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
      actionButton("mem_button", label="set mem value")
    ),
    mainPanel(
      tableOutput("result")
    )
  )
)

server <- function(input, output) {
  superval = reactiveValues(mem = rep(list(0), 10))
  
  # set the future calculations
  observeEvent(input$mem_button, {future({return(subfct( isolate(input$mem_pos)  ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lied the problem 
  
  # show result table
  observe( {output$result = renderTable({unlist(superval$mem)})})
}

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

Getting an input list containing inputs present in the current session

I came up with kind of a workaround, assuming you dont have any inputs that should take a value of NULL. You could set the values of the inputs, that you wish to remove, to NULL and filter for non - NULLs when you display the names.

library(shiny)

ui <- fluidPage(
  tags$script("
    Shiny.addCustomMessageHandler('resetValue', function(variableName) {
              Shiny.onInputChange(variableName, null);
              });
              "
  ),
  sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),

  uiOutput("UI"),

  actionButton(inputId = "btn", label = "Show Inputs"),

  verbatimTextOutput(outputId = "textOp")

)


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

  observeEvent(input$slider,{
    for(nr in 1:3){
      if(nr != input$slider) session$sendCustomMessage(type = "resetValue", message = paste0("txt", nr))      
    }
  })

  output$UI <- renderUI(
    textInput(paste0("txt", input$slider), label = paste0("Slider in position ", input$slider))
  )

  global <- reactiveValues()

  observe({
      inp = c()
      for(name in names(input)){
        if(!is.null(input[[name]])){
          inp <- c(inp, name)
        }
      }
      isolate(global$inputs <- inp)
  })

  output$textOp <- renderText({
    global$inputs
  })
}
shinyApp(ui = ui, server = server)

---

Related Topics