The below "MWE code 1" works as intended. It interpolates the values the user inputs into the matrix (id = input2
) over the slider input periods (id = input1
). Additional scenarios are generated with the click of the single action button which triggers a modal (for later purposes). For illustrative purposes, each scenario is linearly adjusted by a random variable.
I'm trying to adapt the above where additional user inputs into the matrix (always in column groupings of 2, for the 2 values to interpolate) are automatically added to the results
function and plotted, without clicking the action button.
The below "MWE code 2" is my beginning of this implementation, and I end at my current knowledge. (Note the input matrix which expands in groups of 2 columns, and the elimination of the runif()
inflator since presumably each added scenario will be different). How can I modify MWE code 2 to accomplish this? I am stuck.
MWE code 1:
library(shiny)
library(tidyverse)
library(ggplot2)
library(shinyMatrix)
interpol <- function(a,b){ # a = periods, b = matrix inputs
c <- rep(NA,a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y # this interpolates
return(c)}
ui <- fluidPage(
sliderInput('input1','Periods to interpolate (input1):',min=2,max=10,value=10),
matrixInput("input2",
label = "Values to interpolate (input2):",
value = matrix(c(1,5),1,2,dimnames = list(NULL,c("Value 1","Value 2"))),
rows = list(names = FALSE),
class = "numeric"),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
results <- function(){interpol(req(input$input1),req(input$input2))}
numScenarios <- reactiveValues(numS=1)
observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
numScenarios$numS <- (numScenarios$numS+1)})
output$plot <- renderPlot({
req(input$input1,input$input2)
v <- lapply(1:numScenarios$numS,
function(i) tibble(Scenario=i,X=1:input$input1,Y=runif(1)+results())
) %>% bind_rows()
v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
}
shinyApp(ui, server)
MWE code 2:
library(shiny)
library(tidyverse)
library(ggplot2)
library(shinyMatrix)
interpol <- function(a,b){ # a = periods, b = matrix inputs
c <- rep(NA,a)
c[1] <- b[1]
c[a] <- b[2]
c <- approx(seq_along(c)[!is.na(c)],c[!is.na(c)],seq_along(c))$y # this interpolates
return(c)}
ui <- fluidPage(
sliderInput('input1','Periods to interpolate (input1):',min=2,max=10,value=10),
matrixInput("input2",
label = "Values to interpolate (input2) where first row lists scenario number:",
value = matrix(c(1,5),1,2,dimnames = list(NULL,c("Value 1","Value 2"))),
cols = list(extend = TRUE, delta = 2, delete = TRUE, names = TRUE,
editableNames = FALSE, multiheader=TRUE),
rows = list(names = FALSE),
class = "numeric"),
actionButton("add", "Add scenario"),
plotOutput("plot")
)
server <- function(input, output, session) {
results <- function(){interpol(req(input$input1),req(input$input2))}
numScenarios <- reactiveValues(numS=1)
observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
numScenarios$numS <- (numScenarios$numS+1)})
output$plot <- renderPlot({
req(input$input1,input$input2)
v <- lapply(1:numScenarios$numS,
function(i) tibble(Scenario=i,X=1:input$input1,Y=results())
) %>% bind_rows()
v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
})
observe({
req(input$input2)
mm <- input$input2
colnames(mm) <- trunc(1:ncol(mm)/2)+1
isolate(updateMatrixInput(session, "input2", mm))
})
}
shinyApp(ui, server)
See explanatory images below: