The following MWE code interpolates user inputs (Y values in 2-column matrix input grid in sidebar panel, id = input1) over X periods (per slider input in sidebar, id = periods). The custom interpolation function interpol() is triggered in server section by results <- function(){interpol(...)}. User has the option to add or modify scenarios by clicking on the single action button, which triggers a modal housing a 2nd expandable matrix input (id = input2). Interpolation results are presented in the plot in the main panel. So far so good, works as intended.

As drafted, the results function only processes the first matrix input including any modifications to it executed in the 2nd matrix input.

My question: how do I expand the results function to include scenarios > 1 added in the 2nd expandable matrix input, and automatically include them in the output plot? I've been wrestling with a for-loop to do this but don't quite know how. I've avoided for-loops, instead relying on lapply and related. But in practice a user will not input more than 20-30 scenarios max and perhaps a for-loop is a harmless option. But I'm open to any solution and am certainly not wedded to a for-loop!

MWE code:

library(shiny)
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(
    sidebarLayout(
      sidebarPanel(uiOutput("panel"),actionButton("showInput2","Modify/add interpolation")),
      mainPanel(plotOutput("plot1"))
    )
  )

server <- function(input, output, session){
 
  results <- function(){interpol(req(input$periods),req(input$input1))}
  
  output$panel <- renderUI({
    tagList(
      sliderInput('periods','Interpolate over periods (X):',min=2,max=12,value=6),
      uiOutput("input1"))
  })

  output$input1 <- renderUI({
    matrixInput("input1", 
                label = "Interpolation 1 (Y values):",
                value =  matrix(if(isTruthy(input$input2)){c(input$input2[1],input$input2[2])} 
                                  else {c(1,5)},                        # matrix values
                                1, 2,                                   # matrix row/column count
                                dimnames = list(NULL,c("Start","End"))  # matrix column header
                                ),
                rows =  list(names = FALSE),
                class = "numeric")
  })
  
  observeEvent(input$showInput2,{
    showModal(
      modalDialog(
        matrixInput("input2",
          label = "Automatically numbered scenarios (input into blank cells to add):",
          value = if(isTruthy(input$input2)){input$input2}
                  else if(isTruthy(input$input1)){input$input1},
          rows =  list(names = FALSE),
          cols =  list(extend = TRUE,
                       delta = 2,
                       delete = TRUE,
                       multiheader=TRUE),
          class = "numeric"),
    footer = modalButton("Close")
    ))
  })

  observe({
    req(input$input2)
    mm <- input$input2
    colnames(mm) <- paste(trunc(1:ncol(mm)/2) 1, " (start|end)")
    isolate(updateMatrixInput(session, "input2", mm))
  })
  
  output$plot1 <-renderPlot({
    req(results())
    plot(results(),type="l", xlab = "Periods (X)", ylab = "Interpolated Y values")
  })
  
}

shinyApp(ui, server)

CodePudding user response：

As a user can (presumably) add only one scenario at a time, I don't think a for loop is going to help. The way I handle situations like this is to bind additional data to the appropriate reactive in an observeEvent. This will then trigger updates in the necessary outputs automatically. Here's a MWE to illustrate the technique.

library(shiny)
library(tidyverse)

ui <- fluidPage(
  actionButton("add", "Add scenario"),
  plotOutput("plot"),
)

server <- function(input, output, session) {
  v <- reactiveValues(results=tibble(Scenario=1, X=1:10, Y=runif(10)))
  
  observeEvent(input$add, {
    newData <- tibble(Scenario=max(v$results$Scenario)   1, X=1:10, Y=runif(10))
    v$results <- v$results %>% bind_rows(newData)
  })
  
  output$plot <- renderPlot({
    v$results %>% ggplot()   geom_point(aes(x=X, y=Y, colour=as.factor(Scenario)))
  })
}

shinyApp(ui, server)