In R, how to create a dynamic matrix index for a matrix that expands in 2 dimensions?

Question

This post is a bit much. Will post a simpler question getting to the same issue...

The below MWE code is adapted from a matrix that expanded horizontally, but now I'm trying to make it expand in 2 directions, horizontally and vertically. I'm encountering "Error in [: (subscript) logical subscript too long" and in some instances unresponsive matrix inputs, as shown in the images at the bottom.

I'm pretty sure the heart of the problems lie in the matrix indexing buried in lapply(...Y = interpol(input$periods, sanitizedMat()[,(i*2-1):(i*2), drop = FALSE])...

Any ideas how to resolve?

I imagine this takes some mastery of dynamic matrix indexing and nested lapply and/or sapply functions.

The custom interpol() function works fine though it looks nasty. It allows the user to build a curve of values over a time horizon (limited by the overarching "modeled periods" per the slider input), with the left sub-column in each scenario specifying the period and the right sub-column the value to apply in that period, and it:

• Runs error checks and some input correction
• If a row 1 period is > 1, the corresponding right-column value is help constant over those initial periods
• If the last period in a sub-column is < than the max periods per the slider input (for overarching modeled periods), then remaining periods are 0
• Any right-column values with period gaps are interpolated, as shown in the images at the bottom. Main objective of this function is interpolation

Matrix input expands horizontally for additional scenarios. Expands vertically to expand scenario curves. The images at the bottom explain it all.

MWE Code:

library(shiny)
library(shinyMatrix)
library(dplyr)
library(ggplot2)

interpol <- function(a, b) {
  c <- b
  c[,1][c[,1] > a] <- a
  d <- diff(c[,1, drop = FALSE])
  d[d <= 0] <- NA
  d <- c(1,d)
  c <- cbind(c,d)
  c <- na.omit(c)
  c <- c[,-c(3),drop=FALSE]
  e <- rep(NA, a)
  e[c[,1]] <- c[,2]
  e[seq_len(min(c[,1])-1)] <- e[min(c[,1])]
  if(max(c[,1]) < a){e[seq(max(c[,1]) + 1, a, 1)] <- 0}
  e <- approx(seq_along(e)[!is.na(e)], e[!is.na(e)], seq_along(e))$y
  return(e)
}

ui <- fluidPage(
  sliderInput('periods', 'Periods to model:', min=1, max=10, value=10),
  matrixInput(
    "myMatrixInput",
    label = "Build curves: input periods and variables in left and right columns for each scenario (period gaps interpolated)",
    value =  matrix(c(1, 5), 1, 2, dimnames = list(NULL, rep("Scenario 1", 2))),
    cols = list(extend = TRUE, delta = 2, names = TRUE,  delete = TRUE, multiheader = TRUE),
    rows = list(extend = TRUE, delta = 1, names = FALSE, delete = FALSE),
    class = "numeric"),
  plotOutput("plot")
)

server <- function(input, output, session) {
  sanitizedMat <- reactiveVal() # < necessary for vertical matrix expansion
  observeEvent(input$myMatrixInput, {
    if(any(colnames(input$myMatrixInput) == "")){
      tmpMatrix <- input$myMatrixInput
      empty_columns <- sapply(tmpMatrix, function(x) all(is.na(x) | x == ""))
      tmpMatrix <- tmpMatrix[, !empty_columns, drop = FALSE]
      colnames(tmpMatrix) <- paste("Scenario", rep(1:ncol(tmpMatrix), each = 2, length.out = ncol(tmpMatrix)))
      isolate(updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix))
    }
    sanitizedMat(na.omit(input$myMatrixInput))
  })
  
  plotData <- reactive({
    tryCatch( 
      lapply(seq_len(ncol(sanitizedMat())/2),
             function(i){
               tibble(
                 Scenario = colnames(sanitizedMat())[i*2-1],
                 X = seq_len(input$periods),
                 Y = interpol(input$periods, sanitizedMat()[,(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)

Answer 1

See answer to post In R, why am I getting "Error in [: (subscript) logical subscript too long"? for a solution and code example.

Key to solving this were eliminating automated matrix empty column deletion under the single observeEvent() and ignoring NA's when running UDF interpol(). When the subcolumns (grouping of 2 columns under 1 scenario header) are of unequal lengths as new scenarios are added by the user, the shorter subcolumns will have NA's in some of the rows. Just ignore the NA's in calculations and problem solved.