How to define separate reactive values from a common user input matrix in R Shiny?

Question

In running the reactive code below, the user can input a variable "Y" into the first matrix rendered at the top (generated by function matInputBase()) to run a simple scenario where that variable Y appears in only one period in the output, with period set by the slider input for time window "W". The user can optionally input into the following two input matrixes (both generated by function matInputFlex()), additional variable Y's into other specified time periods ("X") so long as they fit into overall time window W. Function matInputFlex() allows the user to run more detailed scenarios than the basic matInputBase(). Note how an input into matInputBase() flows directly into the first row and second column of each matInputFlex(), as shown in the image below. This part works correctly.

However, if the user has input a scenario into one of the matInputFlex() matrixes, and then decides to change any one of the values in matInputBase(), then both of the matInputFlex() matrixes are reset. I don't want both of the matInputFlex() matrixes reset, I would like only the matInputFlex() matrix directly affected by the change to the matInputBase() matrix to be reset. I would like to preserve the matInputFlex() values unaffected by a change to its corresponding parent matInputBase() value. So, for if example, if I have built up a matInputFlex() scenario for Var_1 and then I change a matInputBase() value for Var_2, as shown in the second half of the image below, then only the matInputFlex() values for Var_2 should reset and not the matInputFlex() values for Var_1. How do I delink these reactive tables, so that Var_1 and Var_2 can process independently?

I have played around with isolate() and observeEvent() for input$base_input, but these changes stopped the flow of inputs from matInputBase() to matInputFlex().

Image of how the App works:

Code:

library(shiny)
library(shinyMatrix)

matInputBase <- function(name) {
  matrixInput(name,
              value = matrix(c(1,2), 2, 1, dimnames = list(c("Var_1", "Var_2"), NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric"
  )
}

matInputFlex <- function(name, x,y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 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(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(
  sliderInput("periods","Time window (W):", min = 1, max = 10, value = 10),
  h5(strong("Var (Y) over time window:")),
  matInputBase("base_input"),
  uiOutput("Vectors"),
  tableOutput("table2")
)

server <- function(input, output, session) {
  base_var_1 <- reactive(input$base_input[1,1])
  base_var_2 <- reactive(input$base_input[2,1])
  
  output$Vectors <- renderUI({
    tagList(
      h5(strong("Adjust Var_1 (Y) at time X:")),
      matInputFlex("var_1_input", input$periods, base_var_1()),
      h5(strong("Adjust Var_2 (Y) at time X:")),
      matInputFlex("var_2_input", input$periods, base_var_2())
      )
    })
  output$table2 <- renderTable(
    cbind(
      matStretch(input$var_1_input, input$periods, "Var_1"),
      matStretch(input$var_2_input, input$periods, "Var_2")
      )
    )
}

shinyApp(ui, server)

Answer 1

Edited input$periods event handling from base_input() to isolate(base_input()).

The code below separates output$Vectors into two separate renderUI variables in the server, tracks the previous value of input$base_input to determine which row has changed (if any), and uses observeEvent for more explicit event handling.

It appears to handle matInputBase and matInputFlex events correctly, and it will reset both matInputFlex if input$periods changes.

library(shiny)
library(shinyMatrix)

matInputBase <- function(name) {
  matrixInput(name,
              value = matrix(c(1,2), 2, 1, dimnames = list(c("Var_1", "Var_2"), NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric"
  )
}

matInputFlex <- function(name, x,y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 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(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(
  sliderInput("periods","Time window (W):", min = 1, max = 10, value = 10),
  h5(strong("Var (Y) over time window:")),
  matInputBase("base_input"),
  # Modified to bring the h5 elements into the UI.
  tagList(
    h5(strong("Adjust Var_1 (Y) at time X:")),
    uiOutput("Vectors1"),
    h5(strong("Adjust Var_2 (Y) at time X:")),
    uiOutput("Vectors2")
  ),
  tableOutput("table2")
)

server <- function(input, output, session) {
  
  # Reactive variable storage
  base_input <- reactive(input$base_input)
  prev <- reactiveValues(
    dat = matrix(c(1,2), 2, 1, dimnames = list(c("Var_1", "Var_2"), NULL))
  )
  
  # Separate out the handling of input$base_input.
  observeEvent(
    input$base_input,
    {
      if (prev$dat[1,1] != base_input()[1,1]){
        output$Vectors1 <- renderUI({
          matInputFlex("var_1_input", input$periods, base_input()[1,1])
        })
      }
      if (prev$dat[2,1] != base_input()[2,1]){
        output$Vectors2 <- renderUI({
          matInputFlex("var_2_input", input$periods, base_input()[2,1])
        })
      }
      # Save the current value for testing the next event.
      prev$dat <- base_input()
    })
  
  # Deal with input$periods events separately.
  observeEvent(
    input$periods,
    {
      output$Vectors1 <- renderUI({
        matInputFlex("var_1_input", input$periods, isolate(base_input())[1,1])
      })
      output$Vectors2 <- renderUI({
        matInputFlex("var_2_input", input$periods, isolate(base_input())[2,1])
      })
      
    })
  
  output$table2 <- renderTable(
    cbind(
      matStretch(input$var_1_input, input$periods, "Var_1"),
      matStretch(input$var_2_input, input$periods, "Var_2")
    )
  )
}

shinyApp(ui, server)

Answer 2

Below is another solution that has withstood many test scenarios. Explanation:

• Key was breaking the reactivity linkage between the 2 rows in the primary input matrix, base_input[1,1] and base_input[2,1]. For example, when the user inputs into var_1_input and then goes up to the second row of the first input matrix and changes a value in base_input[2,1], then the var_1_input does not reset; only var_2_input resets. Conversely, when user inputs into var_2_input and then goes up to the first row of the first input matrix and changes a value in base_input[1,1] then the var_2_input does not reset; only var_1_input resets.
• Reactive value initialization: prev_base_var_1 and prev_base_var_2 are initialized without direct reference to input$base_input, avoiding immediate reactivity linkage.
• Conditional reactivity: observers for var_1_input and var_2_input only trigger updates when their respective base_input values change, effectively delinking their reactivity.
• Isolated updates: by updating prev_base_var_1 and prev_base_var_2 only after confirming a change, the code ensures that unrelated inputs (var_1_input or var_2_input) do not reset, maintaining their independence.
• This setup allows each variable (var_1_input and var_2_input) to react only to changes in its corresponding base_input element (base_input[1,1] and base_input[2,1]), achieving the desired delinked reactivity.

Code with comments:

library(shiny)
library(shinyMatrix)

matInputBase <- function(name) {
  matrixInput(name,
              value = matrix(c(1,2), 2, 1, dimnames = list(c("Var_1", "Var_2"), NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric"
  )
}

matInputFlex <- function(name, x,y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 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(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(
  sliderInput("periods","Time window (W):", min = 1, max = 10, value = 10),
  h5(strong("Var (Y) over time window:")),
  matInputBase("base_input"),
  uiOutput("Vector"),
  tableOutput("table2")
)

server <- function(input, output, session) {
  # Initialize previous values for base_input[1,1] and base_input[2,1] as NA
  prev_base_vars <- list(reactiveVal(NA), reactiveVal(NA))
  
  observe({
    # Ensure input$base_input exists and is not NULL
    if (!is.null(input$base_input) && all(!is.na(input$base_input))) {
      
      # Determine the number of rows in base_input
      num_rows <- nrow(input$base_input)
      
      # Loop over each variable
      for (i in 1:num_rows) {
        # Safely access the base_input and previous value
        current_input <- input$base_input[i, 1]
        prev_input <- prev_base_vars[[i]]()
        
        # Check if current_input is different from prev_input and neither is NA
        if (!is.na(current_input) && !is.na(prev_input)) {
          if (current_input != prev_input) {
            matrix_name <- paste0("var_", i, "_input")
            updateMatrixInput(
              session, matrix_name,
              value = matrix(c(input$periods, current_input), 1, 2, dimnames = list(NULL, c("X", "Y")))
            )
            prev_base_vars[[i]](current_input)  # Update the stored previous value
          }
        } else {
          # Initial update if previous value is NA (first run)
          prev_base_vars[[i]](current_input)
        }
      }
    }
  })
  
  output$Vector <- renderUI({
    tagList(
      h5(strong("Adjust Var_1 (Y) at time X:")),
      matInputFlex("var_1_input", input$periods, isolate(input$base_input[1, 1])),
      h5(strong("Adjust Var_2 (Y) at time X:")),
      matInputFlex("var_2_input", input$periods, isolate(input$base_input[2, 1]))
    )
  })
  
  output$table2 <- renderTable(
    cbind(
      matStretch(input$var_1_input, input$periods, "Var_1"),
      matStretch(input$var_2_input, input$periods, "Var_2")
    )
  )
}

shinyApp(ui, server)