Search code examples
rmatrixshinyshiny-reactivity

How do I capture this R Shiny expandable reactive user input matrix as another reactive object for further manipulation?


In the below example R Shiny code, there are two types of input matrixes. The first (rendered at the top in the sidebar panel and generated by function matInputBase()) captures user input variables "Y" and applies them over a time window "W". This top matrix is then split into 2 expandable matrixes (generated by function matInputFlex()), where the user can optionally change variables Y at times "X". I stripped out all the calculations code and leave only the user input matrixes. User input matrixes are generated by package shinyMatrix.

How do I capture as a reactive object these two matrixes generated by matInputFlex(), and for the sake of example, render them in the main panel as a table?

I need to capture that object for download/upload functionality, as well as to make subsequent calculations easier. The data is meant to flow from matInputBase() to matInputFlex() to this to-be-built reactive object that I would like to play around with. Flow is downstream, whereby inputs into matInputBase() flow to matInputFlex(), but they never flow from matInputFlex() to matInputBase(). The below illustration helps explain.

enter image description here

Code:

library(shiny)
library(shinyMatrix)

matInputBase <- function(name){
  matrixInput(name, 
              value = matrix(c(0.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")
}

ui <- fluidPage(
  sidebarPanel(
    sliderInput('periods', 'Time window (W):', min = 1, max = 20, value = 20),
    h5(strong("Var (Y) over time window:")),
    matInputBase("base_input"),
    actionButton('resetVectorBtn', 'Reset'),
    uiOutput("Vectors")
  ), 
  mainPanel(h5("Show the 2 adjustable matrixes here as DF...")) # show new object that copies adjustable
) 

server <- function(input, output, session) {
  periods <- reactive(input$periods)
  base_input <- reactive(input$base_input)

  output$Vectors <- renderUI({
    input$resetVectorBtn
    tagList(
      h5(strong("Adjust Var_1 (Y) at time X:")),
      matInputFlex("var_1_vector_input", input$periods, input$base_input[1, 1]),
      h5(strong("Adjust Var_2 (Y) at time X:")),
      matInputFlex("var_2_vector_input", input$periods, input$base_input[2, 1])
    )
  })
} 

shinyApp(ui, server)

Solution

  • You can just add the relevant table outputs in your UI:

    mainPanel(
        h5("Matrix 1"),
        tableOutput("m1"),
        h5("Matrix 2"),
        tableOutput("m2")
    )
    

    And then in your server function update those when the input changes. As noted in the comment by Limey, the docs state:

    You can access the value from the matrix input using input$inputId in your server function. The result will always be a matrix of the class defined in matrixInput.

    output$m1 <- renderTable(input$var_1_vector_input)
    output$m2 <- renderTable(input$var_2_vector_input)
    

    enter image description here

    Full app code

    library(shiny)
    library(shinyMatrix)
    
    matInputBase <- function(name) {
        matrixInput(name,
            value = matrix(c(0.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"
        )
    }
    
    ui <- fluidPage(
        sidebarPanel(
            sliderInput("periods", "Time window (W):", min = 1, max = 20, value = 20),
            h5(strong("Var (Y) over time window:")),
            matInputBase("base_input"),
            actionButton("resetVectorBtn", "Reset"),
            uiOutput("Vectors")
        ),
        mainPanel(
            h5("Matrix 1"),
            tableOutput("m1"),
            h5("Matrix 2"),
            tableOutput("m2")
        ) # show new object that copies adjustable
    )
    
    server <- function(input, output, session) {
        periods <- reactive(input$periods)
        base_input <- reactive(input$base_input)
    
        output$Vectors <- renderUI({
            input$resetVectorBtn
            tagList(
                h5(strong("Adjust Var_1 (Y) at time X:")),
                matInputFlex("var_1_vector_input", input$periods, input$base_input[1, 1]),
                h5(strong("Adjust Var_2 (Y) at time X:")),
                matInputFlex("var_2_vector_input", input$periods, input$base_input[2, 1])
            )
        })
    
    output$m1 <- renderTable(input$var_1_vector_input)
    output$m2 <- renderTable(input$var_2_vector_input)
    }
    
    shinyApp(ui, server)