[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)
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)
