0

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:

enter image description here

enter image description here

enter image description here

1 Answers1

1

Edit: I'd suggest using a row-based matrixInput. This makes your life much easier, as you don't have to reshape the matrix before passing it to your custom function etc.

Please check the following:

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

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(
  titlePanel("myMatrixInput"),
  sidebarLayout(
    sidebarPanel(
      matrixInput(
        "myMatrixInput",
        label = "Values to interpolate (myMatrixInput) where first row lists scenario number:",
        value =  matrix(c(10, 1, 5), 1, 3, dimnames = list("Scenario 1", c("Periods", "Value 1", "Value 2"))),
        cols = list(
          extend = FALSE,
          names = TRUE, 
          editableNames = FALSE
        ),
        rows = list(names = TRUE,
                    delete = TRUE,
                    extend = TRUE,
                    delta = 1),
        class = "numeric"
      ),
      actionButton("add", "Add scenario")
    ),
    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  
  sanitizedMat <- reactiveVal()
  
  observeEvent(input$myMatrixInput, {
    if(any(rownames(input$myMatrixInput) == "")){
      tmpMatrix <- input$myMatrixInput
      rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
      updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
    }
    sanitizedMat(na.omit(input$myMatrixInput))
  })
  
  plotData <- reactive({
    req(dim(sanitizedMat())[1] >= 1)

    lapply(seq_len(nrow(sanitizedMat())),
                function(i){
                  tibble(
                    Scenario = rownames(sanitizedMat())[i],
                    X = seq_len(sanitizedMat()[i, 1]),
                    Y = interpol(sanitizedMat()[i, 1], sanitizedMat()[i, 2:3])
                  )
                }) %>% bind_rows()
  })

  output$plot <- renderPlot({
    req(nrow(plotData()) > 0)
    plotData() %>% ggplot() + geom_line(aes(
      x = X,
      y = Y,
      colour = as.factor(Scenario)
    ))
  })
}

shinyApp(ui, server)

result2


Initial Answer

There is no need to calulate the numScenarios as they are defined by the dimensions of your matrix. The same applies to the modal you'll add later - just monitor the dimensions of the data to change the plot - no matter which input changes the reactive dataset.

As a general advice I'd recommend working with data.frames in long format instead of a matrix to prepare plots (using e.g. ggplot or plotly). See my answer here for an example.

Please check the following:

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

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(
    'mySliderInput',
    'Periods to interpolate (mySliderInput):',
    min = 2,
    max = 10,
    value = 10
  ),
  matrixInput(
    "myMatrixInput",
    label = "Values to interpolate (myMatrixInput):",
    value =  matrix(c(1, 5), 1, 2, dimnames = list(NULL, c("Value 1", "Value 2"))),
    cols = list(
      extend = TRUE,
      delta = 2,
      delete = TRUE
    ),
    rows =  list(names = FALSE),
    class = "numeric"
  ),
  actionButton("add", "Add scenario"),
  plotOutput("plot")
)

server <- function(input, output, session) {
  
  observeEvent(input$add, {
    showModal(modalDialog(footer = modalButton("Close")))
  })
  
  plotData <- reactive({
    req(dim(input$myMatrixInput)[2] >= 2)
    # req(dim(input$myMatrixInput)[2]%%2 == 0)
    req(input$mySliderInput)
    
    
    if(as.logical(dim(input$myMatrixInput)[2]%%2)){
      myVector <- head(as.vector(input$myMatrixInput), -1)
    } else {
      myVector <- as.vector(input$myMatrixInput)
    }
    
    myMatrix <- matrix(myVector, ncol = 2)
    
    lapply(seq_len(length(myVector)/2),
                function(i){
                  tibble(
                    Scenario = i,
                    X = seq_len(input$mySliderInput),
                    Y = interpol(req(input$mySliderInput), req(myMatrix[i,]))
                  ) 
                }) %>% bind_rows()
  })
  
  output$plot <- renderPlot({
    req(nrow(plotData()) > 0)
    plotData() %>% ggplot() + geom_line(aes(
      x = X,
      y = Y,
      colour = as.factor(Scenario)
    ))
  })
}

shinyApp(ui, server)

result

The above Edit works BEAUTIFULLY. Wow. Now the below simple edit of your edit simply pull the periods to interpolate out of the input matrix and back into a single slider input since in the full model this is meant for, modeled periods have to be the same for all input variables. However your 3 column matrix inputs also help me on another matter so THANK YOU. Also, I removed the "Add scenarios" action button since it is no longer needed with the automatically expanding input matrix. I sure learned a lot with this.

Edit of your edit:

ui <- fluidPage(
  titlePanel("myMatrixInput"),
  sidebarLayout(
    sidebarPanel(
      sliderInput('periods','Periods to interpolate:',min=2,max=10,value=10),
      matrixInput(
        "myMatrixInput",
        label = "Values to interpolate (myMatrixInput):",
        value =  matrix(c(1, 5), 1, 2, dimnames = list("Scenario 1", c("Value 1", "Value 2"))),
        cols = list(extend = FALSE,
                    names = TRUE, 
                    editableNames = FALSE),
        rows = list(names = TRUE,
                    delete = TRUE,
                    extend = TRUE,
                    delta = 1),
        class = "numeric"
      ),
    ),
    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  
  sanitizedMat <- reactiveVal()
  
  observeEvent(input$myMatrixInput, {
    if(any(rownames(input$myMatrixInput) == "")){
      tmpMatrix <- input$myMatrixInput
      rownames(tmpMatrix) <- paste("Scenario", seq_len(nrow(input$myMatrixInput)))
      updateMatrixInput(session, inputId = "myMatrixInput", value = tmpMatrix)
    }
    sanitizedMat(na.omit(input$myMatrixInput))
  })
  
  plotData <- reactive({
    req(dim(sanitizedMat())[1] >= 1)
    lapply(seq_len(nrow(sanitizedMat())),
           function(i){
             tibble(
               Scenario = rownames(sanitizedMat())[i],
               X = 1:input$periods,
               Y = interpol(input$periods, sanitizedMat()[i, 1:2])
             )
           }) %>% bind_rows()
  })
  
  output$plot <- renderPlot({
    req(nrow(plotData()) > 0)
    plotData() %>% ggplot() + geom_line(aes(
      x = X,
      y = Y,
      colour = as.factor(Scenario)
    ))
  })
}

shinyApp(ui, server)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • Hi, I goofed by editing your response which I didn´t mean to. I tried reversing it. But I did edit my original post where I included images. The 2 scenarios I added in the 2nd image (interpolation of {1,10} and {15,20} over the same 6 periods) were not rendered in the plot when I ran it. – Curious Jorge - user9788072 Oct 13 '21 at 08:41
  • Please see my edit - your lapply call was unsuitable. – ismirsehregal Oct 13 '21 at 08:50
  • Please see the 3rd image I just posted. Something funny happens to scenario 1 when posting additional scenarios – Curious Jorge - user9788072 Oct 13 '21 at 09:05
  • Also revised MWE code 2 to reflect automatic column headers to better illustrate the scenarios. – Curious Jorge - user9788072 Oct 13 '21 at 09:11
  • The problem is, that all scenarios are recalculated when adding a new one. On recalculating always the current value of the slider is taken into account (There is no slider value assigned to a value pair). – ismirsehregal Oct 13 '21 at 09:34
  • OK let me noodle over this for a bit, there has to be a way to account for pairs for the values to interpolate. I know it's weird. Hang on.... – Curious Jorge - user9788072 Oct 13 '21 at 10:38
  • Please see another edit - or rather a suggestion. – ismirsehregal Oct 13 '21 at 10:52
  • That edited answer works very well, and I like your re-arrangement by rows; as I look at it, I see that it'll be more intuitive for users to key in inputs this way. However for the full model this framework will be used in, the periods will always be the same for all other input variables. So I'm going to try pulling the periods back out into a single slider input and see what happens....hang on... – Curious Jorge - user9788072 Oct 13 '21 at 13:12
  • OK wonderful edit, exactly. I posted a simple edit of your edit to pull periods out of input matrix and back into a slider input. – Curious Jorge - user9788072 Oct 13 '21 at 13:36