CODEWITHSUNDEEP
rshinyshiny-reactivity
Curious Jorge - user9788072
Curious Jorge - user9788072

Reputation: 2720

How to modify reactivity chain so last object modified controls other chained objects?

[New note 1: final resolved code posted at the very bottom reflecting ismirsehregal's solution of 03-Dec-2021, and some minor tweaks marked "# ADDED" and "# MODIFIED". ADD is for addressing the bug I encountered when deleting rows from matrix 1 after matrix 2 had had values added (as commented below), and "MODIFIED" is to conform column headers for matrices 1 and 2 (there was no point in them having different column headers).

When running the below code, I'd like the last object modified in the reactivity chain to "control" or "dominate" other objects in that reactivity chain. In this code, the chained reactive objects are "matrix1" and "matrix2". Inputs into matrix1 downstream to matrix2, and inputs into the first 2 columns of matrix2 upstream to matrix1. As drafted, inputs into matrix2 trump inputs into matrix1. I'd like whichever matrix was last input into to trump the other matrix. Can someone help me with this?

The images at the bottom help illustrate.

I have messed with isolate() and other things to try getting this to work the way I want. I've also had the problem of the matrices getting caught in a loop where values bounce back and forth between the 2 matrices. I don't have a complete grasp of isolate() yet.

Code:

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

sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      matrixInput("matrix1",
                  label ="Matrix 1 (scenario 1):",
                  value = matrix(c(60,5),ncol=2,dimnames=list(NULL,c("X","Y"))),
                  rows = list(extend = TRUE, delete = TRUE),
                  class = "numeric"),
      actionButton(inputId = "showMat2", "Add scenarios"),br(),br(),
    ),
    mainPanel(plotOutput("plot"))
  )
)

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

  observeEvent(input$matrix1, {
    tmpMat1 <- input$matrix1
    if(any(rownames(input$matrix1) == "")){rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))    }
    isolate(updateMatrixInput(session, inputId = "matrix1", value = tmpMat1))
  })
  
  observeEvent(input$showMat2,{
    showModal(
      modalDialog(
        matrixInput("matrix2",
                    label = "Matrix 2:",
                    value = input$matrix1,
                    rows = list(extend = TRUE, delete = TRUE),
                    cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                    class = "numeric"),
        footer = tagList(modalButton("Close"))
      ))
    observeEvent(input$matrix2, {
      tmpMat2 <- input$matrix2
      rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
      colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
      isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMat2))
      isolate(updateMatrixInput(session, inputId = "matrix1", value = tmpMat2[,1:2]))
    })
  })
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix1)/2), 
             function(i){
               tibble(
                 Scenario= colnames(input$matrix1)[i*2-1],X=seq_len(10),
                 Y=sumMat(input$matrix1[,(i*2-1):(i*2), drop = FALSE])
               )
             }) %>% bind_rows(),
      error = function(e) NULL
    )
  })
  
  output$plot <- renderPlot({
    plotData() %>% ggplot() + 
      geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
      theme(legend.title=element_blank())
  })
}

shinyApp(ui, server)

enter image description here

enter image description here

enter image description here

New note 1: final resolved code below

sumMat <- function(x) {return(rep(sum(x, na.rm = TRUE), 10))}

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    matrixInput(
      "matrix1",
      label = "Matrix 1:", # MODIFIED HEADER
      value = matrix(c(60,5),ncol=2,dimnames=list(NULL,rep("Scenario 1",2))), # MODIFIED HEADER
      rows = list(extend = TRUE, delete = TRUE),
      cols = list(multiheader = TRUE), # ADD
      class = "numeric"
    ),
    actionButton(inputId = "showMat2", "Add scenarios"),br(),br(),
  ),
  mainPanel(plotOutput("plot"))
))

server <- function(input, output, session) {
  
  currentMat <- reactiveVal(isolate(input$matrix1))
  
  observeEvent(input$matrix1, {
    tmpMat1 <- input$matrix1
    if(any(rownames(input$matrix1)=="")){rownames(tmpMat1)<-paste("Row",seq_len(nrow(input$matrix1)))}
    updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
    
    tmpMat2 <- currentMat()
    
    if(nrow(tmpMat1) > nrow(tmpMat2)){tmpMat2 <- rbind(tmpMat2, rep(NA, ncol(tmpMat2)))}
  
    # ADDED
    if(nrow(tmpMat2) > nrow(tmpMat1)){tmpMat1 <- rbind(tmpMat1, rep(NA, ncol(tmpMat1)))}
  
    currentMat(cbind(tmpMat1[drop=FALSE], tmpMat2[,-1:-2,drop=FALSE]))
  })
  
  observeEvent(input$showMat2, {
    showModal(modalDialog(
      matrixInput(
        "matrix2",
        label = "Matrix 2:",
        value = currentMat(),
        rows = list(extend = TRUE, delete = TRUE),
        cols = list(extend = TRUE,delta = 2,delete = TRUE,multiheader = TRUE),
        class = "numeric"
      ),
      footer = tagList(modalButton("Close"))
    ))
  })
  
  observeEvent(input$matrix2, {
    tmpMat2 <- input$matrix2
    rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
    colnames(tmpMat2) <-
      paste("Scenario", rep(1:ncol(tmpMat2),each = 2,length.out = ncol(tmpMat2)))
    currentMat(tmpMat2)
    updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
    updateMatrixInput(session, inputId = "matrix1", value = tmpMat2[, 1:2, drop = FALSE])
  })
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix1) / 2),
             function(i) {
               tibble(
                 Scenario = colnames(input$matrix1)[i * 2 - 1],
                 X = seq_len(10),
                 Y = sumMat(input$matrix1[, (i * 2 - 1):(i * 2), drop = FALSE])
               )
             }) %>% bind_rows(),
      error = function(e)
      NULL
    )
  })
  
  output$plot <- renderPlot({
    plotData() %>% ggplot() +
      geom_line(aes(
        x = X,
        y = Y,
        colour = as.factor(Scenario)
      )) +
      theme(legend.title = element_blank())
  })
}

shinyApp(ui, server)

Upvotes: 2

Views: 112

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33442

The following seems to work:

  • remember to use drop = FALSE
  • never nest observers
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)

sumMat <- function(x) {
  return(rep(sum(x, na.rm = TRUE), 10))
}

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    matrixInput(
      "matrix1",
      label = "Matrix 1 (scenario 1):",
      value = matrix(c(60, 5), ncol = 2, dimnames = list(NULL, c("X", "Y"))),
      rows = list(extend = TRUE, delete = TRUE),
      class = "numeric"
    ),
    actionButton(inputId = "showMat2", "Add scenarios"),
    br(),
    br(),
  ),
  mainPanel(plotOutput("plot"))
))

server <- function(input, output, session) {
  
  currentMat <- reactiveVal(isolate(input$matrix1))
  
  observeEvent(input$matrix1, {
    tmpMat1 <- input$matrix1
    if (any(rownames(input$matrix1) == "")) {
      rownames(tmpMat1) <- paste("Row", seq_len(nrow(input$matrix1)))
    }
    updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
    
    tmpMat2 <- currentMat()
    if(nrow(tmpMat1) > nrow(tmpMat2)){
      tmpMat2 <- rbind(tmpMat2, rep(NA, ncol(tmpMat2)))
    }
    if(nrow(tmpMat2) > nrow(tmpMat1)){
      tmpMat1 <- rbind(tmpMat1, rep(NA, ncol(tmpMat1)))
    }
    currentMat(cbind(tmpMat1, tmpMat2[,-1:-2]))
  })
  
  observeEvent(input$showMat2, {
    showModal(modalDialog(
      matrixInput(
        "matrix2",
        label = "Matrix 2:",
        value = currentMat(),
        rows = list(extend = TRUE, delete = TRUE),
        cols = list(
          extend = TRUE,
          delta = 2,
          delete = TRUE,
          multiheader = TRUE
        ),
        class = "numeric"
      ),
      footer = tagList(modalButton("Close"))
    ))
  })
  
  observeEvent(input$matrix2, {
    tmpMat2 <- input$matrix2
    rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
    colnames(tmpMat2) <-
      paste("Scenario", rep(
        1:ncol(tmpMat2),
        each = 2,
        length.out = ncol(tmpMat2)
      ))
    currentMat(tmpMat2)
    updateMatrixInput(session, inputId = "matrix2", value = tmpMat2)
    updateMatrixInput(session, inputId = "matrix1", value = tmpMat2[, 1:2, drop = FALSE])
  })
  
  plotData <- reactive({
    tryCatch(
      lapply(seq_len(ncol(input$matrix1) / 2),
             function(i) {
               tibble(
                 Scenario = colnames(input$matrix1)[i * 2 - 1],
                 X = seq_len(10),
                 Y = sumMat(input$matrix1[, (i * 2 - 1):(i * 2), drop = FALSE])
               )
             }) %>% bind_rows(),
      error = function(e)
        NULL
    )
  })
  
  output$plot <- renderPlot({
    plotData() %>% ggplot() +
      geom_line(aes(
        x = X,
        y = Y,
        colour = as.factor(Scenario)
      )) +
      theme(legend.title = element_blank())
  })
}

shinyApp(ui, server)

Upvotes: 1

Related Questions