Search code examples
rshinyobserversshiny-reactivity

In R Shiny, why does one observeEvent() nullify another observeEvent()?


In running the below code, observeEvent(input$matrix2, {...}) is nullifying observeEvent(input$matrix1, {...}). Why is this happening and how do I fix?

Matrix 1 and matrix 2 are linked. Values from matrix 1 downstream to matrix 2 as matrix 2 "Scenario 1", and matrix 2 allows the user to input additional scenarios via horizontally-expanding matrix. Matrix 2 is rendered in modal dialog, after clicking the single action button. The App (plot) works fine when matrix 1 is input into first (plotting user inputs into both matrices 1 and 2 as it should); but when matrix 2 is viewed (with our without any user inputs into the matrix 2) before inputting into matrix 1, then matrix 1 is rendered useless. By useless I mean inputs into matrix 1 are no longer plotted.

Output for illustration purposes is simply the sum of matrix inputs, plotted over 10 periods, per sumMat(...) function.

I've played around with all variations of isolate(...), req(...), etc., with no luck so far.

The images at the bottom illustrate the issue: the first 2 images show the App working well when inputting into matrix 1 first; the 3rd images shows the failure when accessing matrix 2 before matrix 1.

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",
                  value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
                  rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
      actionButton("matrix2show","Add scenarios"),
      ),
    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)))}
    updateMatrixInput(session, inputId = "matrix1", value = tmpMat1)
  })
  
  observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
    req(input$matrix1)
    a <- apply(input$matrix2,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
    b <- apply(input$matrix1,2,'length<-',max(nrow(input$matrix2),nrow(input$matrix1)))
    c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
    d <- ncol(input$matrix2)
    
    tmpMat2 <- matrix(c(c), ncol = d)
    tmpMat2[1,2] <- input$matrix1[1,2] 
    colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
    rownames(tmpMat2) <- paste("Row", seq_len(nrow(input$matrix2)))
    
    updateMatrixInput(session,inputId="matrix2",value=tmpMat2)
  })
  
  observeEvent(input$matrix2show,{
    showModal(
      modalDialog(
        matrixInput("matrix2",
                    label = "Matrix 2 (Value Y applied in Period X):",
                    value = if(is.null(input$matrix2))
                    {matrix(c(input$matrix1[,1],input$matrix1[,2]), 
                            ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))}
                    else {input$matrix2},
                    rows = list(extend = TRUE, delete = TRUE),
                    cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                    class = "numeric"),
      footer = tagList(modalButton("Exit box"))
      ))
  })
  
  plotData <- reactive({
    tryCatch(
      if(isTruthy(input$matrix2)){
        lapply(seq_len(ncol(input$matrix2)/2), # column counter to set matrix index as it expands
               function(i){
                 tibble(Scenario = colnames(input$matrix2)[i*2-1],
                   X = seq_len(10),Y = sumMat(input$matrix2[,(i*2-1):(i*2), drop = FALSE]))
               }) %>% bind_rows()
        }
      else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
      error = function(e) NULL)
  })
  
  output$plot <- renderPlot({
    req(plotData())
    plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
  })
}

shinyApp(ui, server)

enter image description here

enter image description here

enter image description here


Solution

  • This is a partial solution. Each time you click on the actionButton, you are creating the same ID for matrix2. That is a problem as Shiny requires unique ID. Once we adjust for that, it works fine. See below. You still need to work on how to display the previous columns of input$matrix2.

    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",
                      value = matrix(c(60,5), ncol = 2, dimnames = list(NULL,c("X","Y"))),
                      rows = list(extend = TRUE, delete = TRUE), class = "numeric"),
          actionButton("matrix2show","Add scenarios"),
        ),
        mainPanel(plotOutput("plot"))  
      )    
    )
    
    server <- function(input, output, session){
      rv <- reactiveValues(tmpMat=NULL)
      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)
      })
      
      
      observeEvent(input$matrix2, { ### updates matrix 2 to reflect larger of matrix 1 and matrix 2 rows
        req(input[[paste0("matrix2",input$matrix2show)]])
        req(input$matrix1)
        imatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
        a <- apply(imatrix2,2,'length<-',max(nrow(imatrix2),nrow(input$matrix1)))
        b <- apply(input$matrix1,2,'length<-',max(nrow(imatrix2),nrow(input$matrix1)))
        c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
        d <- ncol(imatrix2)
        
        tmpMat2 <- matrix(c(c), ncol = d)
        tmpMat2[1,2] <- input$matrix1[1,2] 
        colnames(tmpMat2) <- paste("Scenario",rep(1:ncol(tmpMat2),each=2,length.out=ncol(tmpMat2)))
        rownames(tmpMat2) <- paste("Row", seq_len(nrow(imatrix2)))
        
        updateMatrixInput(session,inputId=paste0("matrix2",input$matrix2show),value=tmpMat2)
        rv$tmpMat <- tmpMat2
      })
      observe({print(rv$tmpMat)})
      observeEvent(input$matrix2show,{
        if (input$matrix2show==1) ivalue <- matrix(c(input$matrix1[,1],input$matrix1[,2]), 
                                                   ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2)))
        else{ if (!is.null(rv$tmpMat)) ivalue <- rv$tmpMat else ivalue <- input$matrix1}
        showModal(
          modalDialog(
            matrixInput(paste0("matrix2",input$matrix2show),
                        label = "Matrix 2 (Value Y applied in Period X):",
                        value = ivalue,
                        rows = list(extend = TRUE, delete = TRUE),
                        cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
                        class = "numeric"),
            footer = tagList(modalButton("Exit box"))
          ))
      })
      
      plotData <- reactive({
        req(input$matrix1)
        imatrix2 <- input[[paste0("matrix2",input$matrix2show)]]
        tryCatch(
          if(isTruthy(imatrix2)){
            lapply(seq_len(ncol(imatrix2)/2), # column counter to set matrix index as it expands
                   function(i){
                     tibble(Scenario = colnames(imatrix2)[i*2-1],
                            X = seq_len(10),Y = sumMat(imatrix2[,(i*2-1):(i*2), drop = FALSE]))
                   }) %>% bind_rows()
          }
          else {tibble(Scenario = "Scenario 1", X = seq_len(10),Y = sumMat(input$matrix1))},
          error = function(e) NULL)
      })
      
      output$plot <- renderPlot({
        req(plotData())
        plotData() %>% ggplot() + geom_line(aes(x = X, y = Y, colour = as.factor(Scenario)))
      })
    }
    
    shinyApp(ui, server)