In the below shortened code, user inputs are "linked" in a series of 3 user input matrices:
- Matrix 1: if user wants to run a rough and quick scenario, user inputs into matrix 1 only. One variable, one scenario only.
- Matrix 2: if user wants to run a more complex scenario, user optionally inputs into matrix 2 with the previous matrix 1 input "downstreaming" to row 1 / column 2 of matrix 2. Matrix 2 expands vertically to accommodate additional user inputs for generating a curve (curve build not functioning in this code for sake of simplicity).
- Matrix 3: if user wants to run multiple complex scenarios, user optionally inputs into matrix 3, with scenario 1 of matrix 3 a downstream mirror reflection of previous inputs into matrix 2. Matrix 3 expands vertically and horizontally, to accommodate user inputs + additional scenarios.
For the sake of simplicity, the below code plots a simple (and nonsensical) sumProduct calculation.
I've used observeEvent to successfully downstream the following user inputs:
-
observeEvent(input$matrix1...downstreams user input from matrix 1 to matrix 2, and -
observeEvent(input$matrix2...downstreams user input from matrix 2 to matrix 3/scenario 1 while preserving all previous inputs into scenarios > 1 in matrix 3 as matrix 2 and matrix 3/scenario 1 simulatenously change.
What I have been unable to do is have user inputs into matrix 1 preserve (NOT ERASE) previous user inputs into matrix 3 scenarios > 1, the way observeEvent(input$matrix2... does this when matrix 2 is changed by the user. I've tried all sorts of observeEvent variations with no luck. I'm trying to nest observeEvents to get this to work but no luck yet (nesting observeEvent(input$matrix2... inside of observeEvent(input$matrix1... , for example). Any ideas on how to do this? Or should I be using a simple observe instead?
Here's the code:
library(dplyr)
library(ggplot2)
library(shiny)
library(shinyMatrix)
sumProd <- function(a, b) {
c <- rep(NA, a)
c[] <- sum(b[,1], na.rm = T) %*% sum(b[,2],na.rm = T)
return(c)
}
ui <- fluidPage(
sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),
matrixInput("matrix1",
value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),
cols = list(names = FALSE),
class = "numeric"),
matrixInput("matrix2",
value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),
rows = list(extend = TRUE, delete = TRUE),
class = "numeric"),
matrixInput("matrix3",
value = matrix(c(10,5), ncol = 2, dimnames = list(NULL, rep("Scenario 1", 2))),
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
plotOutput("plot")
)
server <- function(input, output, session){
observeEvent(input$matrix1, {
tmpMat2 <- c(input$matrix2[,1],input$matrix2[,2])
tmpMat2[length(input$matrix2)/2+1] <- input$matrix1[,1]
updateMatrixInput(session,inputId="matrix2",value=matrix(tmpMat2,ncol=2,dimnames=list(NULL,c("X","Y")))
)
})
observeEvent(input$matrix2, {
a <- apply(input$matrix3,2,'length<-',max(nrow(input$matrix3),nrow(input$matrix2)))
b <- apply(input$matrix2,2,'length<-',max(nrow(input$matrix3),nrow(input$matrix2)))
c <- if(length(a) == 2){c(b)} else {c(b,a[,-1:-2])}
d <- ncol(input$matrix3)
tmpMat3 <- matrix(c(c), ncol = d)
colnames(tmpMat3) <- paste("Scenario",rep(1:ncol(tmpMat3),each=2,length.out=ncol(tmpMat3)))
if(any(rownames(input$matrix2) == "")){
tmpMat3 <- input$matrix2
rownames(tmpMat3) <- paste("Row", seq_len(nrow(input$matrix2)))
isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMat3))
isolate(updateMatrixInput(session, inputId = "matrix3", value = tmpMat3))
}
input$matrix2
updateMatrixInput(session, inputId = "matrix3", value = tmpMat3
)
})
observeEvent(input$matrix3, {
if(any(colnames(input$matrix3) == "")){
tmpMat3 <- input$matrix3
colnames(tmpMat3) <- paste("Scenario",rep(1:ncol(tmpMat3),each=2,length.out=ncol(tmpMat3)))
isolate(updateMatrixInput(session, inputId = "matrix3", value = tmpMat3))
}
input$matrix3
})
plotData <- reactive({
tryCatch(
lapply(seq_len(ncol(input$matrix3)/2), # column counter to set matrix index as it expands
function(i){
tibble(
Scenario = colnames(input$matrix3)[i*2-1],
X = seq_len(input$periods),
Y = sumProd(input$periods,input$matrix3[,(i*2-1):(i*2), drop = FALSE])
)
}) %>% bind_rows(),
error = function(e) NULL
)
})
output$plot <- renderPlot({
req(plotData())
plotData() %>% ggplot() +
geom_line(aes(x = X, y = Y, colour = as.factor(Scenario))) +
theme(legend.title=element_blank())
})
}
shinyApp(ui, server)