My help request is sort of hard to describe so I employ images at the bottom to better explain.
As currently drafted, the user optionally inputs into a slider and 2 matrices. Works fine! However, if the user changes the slider value OR the single value in matrix 1, I would like the first row of matrix 2 to reactively show the revised value of the slider (in column 1 of matrix 2) and/or the revised value of matrix 1 (in column 2 of matrix 2). It's easier if you quickly review the images at the bottom.
No other rows in matrix 2 would ever be affected by changes in slider or matrix 1. Only this first row is impacted.
Any user changes to matrix 2 do not need to be reflected in matrix 1. For purposes of all subsequent calculations in the full App, matrix 2 governs.
How would this be done? By reactively changing the values in function m2 and "refreshing" the matrix2.input function?
The first matrix is governed by the functions m1 (for initial matrix values) and matrix1.input. The second matrix is governed by functions m2 and matrix2.input.
The second matrix extends. If you want to fiddle with it, click and input into the right-most column before clicking on the left-most column. This is due to a minor bug in shinyMatrix that I have a fix for but haven't yet implemented.
Here´s the almost-MWE code. I wouldn't worry about the matrix.validate, vector, and vector.final functions (I could have taken them out for MWE). The observeEvent functions at the bottom are for my testing and could have been removed. And the commented-out row, yield_vector_input <- reactive(input$yield_base_input), is one of my pitiful attempts to "crack this nut".
library(shiny); library(shinyMatrix)
# --- Sets up initial values for base performance input matrix
m1 <- function(x) {matrix(c(0.2), 1, 1, dimnames = list(c("Yield"),NULL))}
# --- Sets up initial values for performance vectors input matrix
m2 <- function(x) {matrix(c(60,0.2), 1, 2, dimnames = list(NULL, c("Y (period)", "Z (variable)")))}
# --- Matrix input function to use for base performance
matrix1.input <- function(x) {
matrixInput(
x,
label = "Base performance:",
value = {m1()},
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
# --- Matrix input function to use for performance vector inputs
matrix2.input <- function(x) {
matrixInput(
x,
label = "Generate yield performance vector:",
value = {m2()},
rows = list(extend = TRUE, names = FALSE),
cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
class = "numeric")}
# --- Auto-correct user inputs into column Y of the input matrix
matrix.validate <- function(x,y){
a <- x
a[,1][a[,1]>y] <- y
b <- diff(a[,1,drop=FALSE])
b[b<=0] <- NA
b <- c(1,b)
a <- cbind(a,b)
a <- na.omit(a)
a <- a[,-c(3),drop=FALSE]
return(a)}
# --- Vector function interpolates & spreads input across even time horizon
vector <- function(X,Y,Z){
a <- rep(NA, X)
a[Y] <- Z
a[seq_len(min(Y)-1)] <- a[min(Y)]
if(max(Y) < X){a[seq(max(Y)+1, X, 1)] <- 0}
a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)], seq_along(a))$y
b <- seq(1:X)
c <- data.frame(X = b, Z = a)
return(c)}
# --- Runs vector through matrix.validate to output clean vector data
vector.final <- function(x,y){vector(x,matrix.validate(y,x)[,1],matrix.validate(y,x)[,2])}
# --- UI and Server sections
ui <- fluidPage(style = "margin-top:10px;margin-left:10px;margin-right:10px",
column(3,
fluidRow(
sliderInput("periods", "Nbr of periods to model:",min = 1, max = 120, value = 60)),
# --- Action button and matrix input for yield
fluidRow(style="margin-left:5px;margin-right:5px;margin-top:5px",
matrix1.input("base_input"),
matrix2.input("yield_vector_input")),
), # close column
column(9,style = "text-align:center",plotOutput("graph1"),
) # close column
) # fluid page
server <- function(input, output) {
# --- Set reactive input variables
periods <- reactive(input$periods)
yield_base_input <- reactive(input$yield_base_input)
yield_vector_input <- reactive(input$yield_vector_input)
# yield_vector_input <- reactive(input$yield_base_input)
# --- Yield plot
output$graph1 <- renderPlot({
plot({vector.final(periods(),yield_vector_input())},
type="b",main='Gross yield vector',xlab='X (time horizon)',ylab = 'Z (yield in period X)')})
# --- Captures inputs and outputs as global variables
observeEvent(periods(), {periods.R <<- unique(periods())})
observeEvent(yield_vector_input(), {yield_input.R <<- unique(yield_vector_input())})
observeEvent(matrix.validate(yield_vector_input(),periods()), {yield_validate.R <<- unique(matrix.validate(yield_vector_input(),periods()))})
observeEvent(vector.final(periods(),yield_vector_input()),{yield_vector.R <<- unique(vector.final(periods(),yield_vector_input()))})
} # closes server
shinyApp(ui = ui, server = server)
Here are notated images to help explain:
- First image shows the default screen that appears when running the above code.
- Second image shows what I am trying to achieve in the 1st row, 1st column of matrix 2 when changing the slider input at the top.
- Third image shows what I am trying to achieve in the 1st row, 2nd column of matrix 2 when changing the single value in matrix 1.


