I am simplifying a web of tangled code and I am about halfway there with the below MWE. The below as posted runs as intended (for me). If the code looks confusing, it was much worse before.

Please look at vectorVariable in server section, marked with # ???. Why does the first vectorVariable work, whereby the 2nd vectorVariable immediately beneath it, commented out, causes an error message when uncommented (and the first one commented out) and running the App? The first vectorVariable references vectorMultiFinal which has been neutered by passing its values straight on to vectorMulti, and the 2nd vectorVariable goes straight to the vectorMulti function. (In my process of simplifying, I merged the functions of vectorMultiFinal into vectorMulti and left vectorMultiFinal as a pass-through "shell" so I could make sure the App continues working every step of simplification).

The purpose of the App is to present the user with a default x value in slider input and a default y value in 1st matrix (flatRate function), and then "build a curve" around that base in the 2nd matrix (curveRate function) by manipulating/adding x and y values in the matrices.

Note that in the version of shinyMatrix package that I'm running, when presented with a 2 column matrix, I have to input into the right-most column first and then go left. There's a minor bug in shinyMatrix that I need to download the fix for from gitHub.

MWE code:

rm(list = ls())

library(shiny)
library(shinyMatrix)

### 1st user input matrix ###
flatRate <- function(inputId){
  matrixInput(inputId, 
              value = matrix(c(0.05), 1, 1, dimnames = list(c("Initial rate (Y)"),NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")} 

### 2nd user input matrix ###
curveRate <- function(InputId,x,y){ # x = period to apply y, y = variable applied in period x
  matrixInput(InputId,
              value = matrix(c(x,y),1,2,dimnames=list(NULL,c("Period X","Curved rate Y"))),
              rows = list(extend = TRUE,  names = FALSE),
              cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
              class = "numeric")}  

### Corrects user inputs in "curveRate" input matrix ###
curveCorrect <- function(x,y){ # x = slider input model periods, y = "curveRate" inputs
  a <- y
  a[,1][a[,1]>x] <- x          # a assigns value of period x to any input period in "curveRate" > x
  b <- diff(a[,1,drop=FALSE])  # b ensures "curveRate" period inputs are in increasing order
  b[b<=0] <- NA                # flag any instances of period inputs in decreasing order with NA
  b <- c(1,b)                  # See above 2 explanations
  a <- cbind(a,b)
  a <- na.omit(a)              # deletes rows with element NA
  a <- a[,-c(3),drop=FALSE]    # deletes column inserted above to flag NA
  return(a)}

### Interpolates & spreads matrix inputs across even time horizon ###
vectorMulti <- function(x,y){ # x = number of modeled periods, y = "curveCorrect" output
  a <- rep(NA, x)                                                     # generates single column vector of NA numbering x periods
  a[y[,1]] <- y[,2]                                                   # places each variable y[,2] in position indicated by its respective period y[,1]
  a[seq_len(min(y[,1])-1)] <- a[min(y[,1])]                           # if 1st period y[,1] > 1, applies that variable y[,2] to all periods <= y[,1]
  if(max(y[,1]) < x){a[seq(max(y[,1]) 1, x, 1)] <- 0}                 # applies 0 to all periods after max period specified in y[,1] up to period x
  a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y    # the only NA's remaining, after the above, are periods to interpolate using approx
  b <- seq(1:x)                                                       # creates single column vector for number of x periods
  c <- data.frame(x=b,y=a)                                            # merges b and a into data frame, assigns column header labels of x and y
  return(c)}

vectorMultiFinal <- function(x,y){vectorMulti(x,curveCorrect(x,y))} # ???

ui <- fluidPage(
        column(9,
                sliderInput('periods','Periods (X):',min=1,max=12,value=6),
                flatRate("ratesBaseInput"),
                actionButton('resetRatesVectorBtn','Reset'),
                uiOutput("ratesVectors"),
                plotOutput("plot1"),
        )
      )

server <- function(input,output,session)({
  
  periods        <- reactive(input$periods)
  ratesBaseInput <- reactive(input$ratesBaseInput)
  ratesInput     <- reactive(input$ratesInput)
  
  vectorVariable <- function(y){vectorMultiFinal(periods(),curveCorrect(periods(),y))} # ???
  # vectorVariable <- function(y){vectorMulti(periods(),curveCorrect(periods(),y))}    # ???
  
  rates <- function(){vectorVariable(ratesInput())}
  
  output$ratesVectors <- renderUI({
    input$resetRatesVectorBtn
    curveRate("ratesInput",input$periods,input$ratesBaseInput[1,1])
  }) # close render UI
  
  output$plot1 <-renderPlot({plot(rates())})
 
}) # close server

shinyApp(ui, server)

CodePudding user response：

Use req() to resolve your issue.

server <- function(input,output,session)({
  
  periods        <- reactive(input$periods)
  ratesBaseInput <- reactive(input$ratesBaseInput)
  ratesInput     <- reactive(input$ratesInput)
  
  #vectorVariable <- function(y){vectorMultiFinal(periods(),curveCorrect(periods(),y))} # ???
  vectorVariable <- function(y){vectorMulti(periods(),curveCorrect(periods(),y))}    # ???
  
  rates <- function(){vectorVariable(req(ratesInput()))}  ####<-------   use req()
  
  output$ratesVectors <- renderUI({
    req(input$periods,input$ratesBaseInput)
    input$resetRatesVectorBtn
    curveRate("ratesInput",input$periods,input$ratesBaseInput[1,1])
  }) # close render UI
  
  output$plot1 <-renderPlot({req(rates())
    plot(rates())})
  
}) # close server