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

Question

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)

Answer 1

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)