Search code examples
rshinyshiny-reactivity

How to make these reactive table objects independent of each other?

The below R Shiny code generates 3 linked user input tables using package rhandsontable: the first, base_input, allows the user to make static inputs and the next 2 user input tables, var_1_input and var_2_input (collectively, "var_x_input"), are reactively fed values from base_input and the slider input (input$periods) for time horizon, and allow the user to alter the time dimension in their respective left-most user input columns labeled "X". The image below shows the data flows.

Note that the first cell of base_input links to var_1_input, and the second cell of base_input links to var_2_input. I am trying to delink the var_x_input objects from each other, where a change in the first cell of base_input only resets var_1_input and a change in the second cell of base_input only resets var_2_input. As the below code currently and incorrectly works, if any of the var_x_input tables has been expanded by the user with values inserted, and if any of the base_input values are changed, then both of the var_x_input tables are reset. Only the linked var_x_input table should have reset. The below diagram shows the issue. Any suggestions for how to resolve this?

enter image description here

Code:

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  sliderInput("periods", "Time window (W):", min = 1, max = 10, value = 5),
  h5(strong("Variable (Y) over window (W):")),
  rHandsontableOutput("base_input"),  
  uiOutput("Vectors")
)

server <- function(input, output, session) {
  numVars <- 2  # Number of variables to model
  
  baseValues <- reactiveValues(data = rep(20, numVars))
  
  output$base_input <- renderRHandsontable({
    rhandsontable(
      data.frame(Inputs = baseValues$data),
      readOnly = FALSE,
      colHeaders = c('Inputs'),
      rowHeaders = paste0("Var ", LETTERS[1:numVars]),
      contextMenu = FALSE  
    )
  })
  
  observeEvent(input$base_input, {
    baseValues$data <- hot_to_r(input$base_input)$Inputs
  })
  
  output$Vectors <- renderUI({
    lapply(1:numVars, function(i) {
      varInputId <- paste0("var_", i, "_input")
      list(
        h5(strong(paste("Adjust Var ", LETTERS[i], " (Y) at time X:"))),
        rHandsontableOutput(varInputId)
      )
    })
  })
  
  lapply(1:numVars, function(i) {
    output[[paste0("var_", i, "_input")]] <- renderRHandsontable({
      if (!is.null(input$base_input)) {
        data <- hot_to_r(input$base_input)
        rhandsontable(
          data.frame(X = input$periods, Y = data$Inputs[i]),
          readOnly = FALSE,
          rowHeaders = NULL,
          colHeaders = c("X", "Y"),
          contextMenu = TRUE  
        )
      }
    })
  })
}

shinyApp(ui, server)
Solution

  • This seems to work. I use a reactive value for each value in the Inputs column.

    library(shiny)
library(rhandsontable)

ui <- fluidPage(
  sliderInput("periods", "Time window (W):", min = 1, max = 10, value = 5),
  h5(strong("Variable (Y) over window (W):")),
  rHandsontableOutput("base_input"),  
  uiOutput("Vectors")
)

server <- function(input, output, session) {
  numVars <- 2  # Number of variables to model
  
  baseValues <- reactiveValues(data = rep(20, numVars))
  
  output$base_input <- renderRHandsontable({
    rhandsontable(
      data.frame(Inputs = baseValues$data),
      readOnly = FALSE,
      colHeaders = c('Inputs'),
      rowHeaders = paste0("Var ", LETTERS[1:numVars]),
      contextMenu = FALSE  
    )
  })
  
  IndividualValues <- replicate(numVars, reactiveVal(), simplify = FALSE)
  
  observeEvent(input$base_input, {
    values <- hot_to_r(input$base_input)$Inputs
    baseValues$data <- values
    lapply(1:numVars, function(i) {
      IndividualValues[[i]](values[i])
    })
  })
  
  output$Vectors <- renderUI({
    lapply(1:numVars, function(i) {
      varInputId <- paste0("var_", i, "_input")
      list(
        h5(strong(paste("Adjust Var ", LETTERS[i], " (Y) at time X:"))),
        rHandsontableOutput(varInputId)
      )
    })
  })
  
  lapply(1:numVars, function(i) {
    output[[paste0("var_", i, "_input")]] <- renderRHandsontable({
      y <- IndividualValues[[i]]()
      if (!is.null(y)) {
        rhandsontable(
          data.frame(X = input$periods, Y = y),
          readOnly = FALSE,
          rowHeaders = NULL,
          colHeaders = c("X", "Y"),
          contextMenu = TRUE  
        )
      }
    })
  })
}

shinyApp(ui, server)