How do I create a repeatable function with reactive code in r shiny?

Question

The MWE code at the bottom works as intended (ignore any minor bugs, some may appear as a result of skinnying the code down from the complete code but they're not relevant to addressing the question at hand).

However in the complete App that this is extracted from, the code shown immediately below this paragraph is repeated extensively, always in reactive sections; I have been trying to wrap it into a function for the sake of code clarity and brevity (you'll see it referenced 3 times in the MWE at the bottom):

if(input$showVectorBtn == 0) vector.base(periods(),input$base_input[1,1])
         else vector.multiFinal(periods(),matrix.validate(periods(),vector_input()))

Here's my latest attempt to functionalize this, you'll see it in the function section in the MWE at the bottom; note that this isn't actually called upon in the below server section because it crashes the App:

# --- Attempt to create function for Reactive code
vectorVariable <- function(x,y){
  reactive({
    if(input$showVectorBtn == 0) vector.base(periods(),x)
    else vector.multiFinal(periods(),matrix.validate(periods(),y))
  })
}

So my question is: how do I create a function with this reactive code?

Here's the MWE code, should work for you with a simple copy/paste once any missing packages are downloaded:

library(shiny)
library(shinyMatrix)
library(shinyjs)
library(DT)

matrix1.input <- function(x){
  matrixInput(x, 
    value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
    rows = list(extend = FALSE,  names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric")}

matrix2.input <- function(x,y,z){
  matrixInput(x,
    value = matrix(c(y,z),1,2,dimnames=list(NULL,c("Y","Z"))),
    rows = list(extend = TRUE,  names = FALSE),
    cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
    class = "numeric")}  

matrix.validate <- function(x,y){
  a <- y        
  a[,1][a[,1]>x] <- x 
  b <- diff(a[,1,drop=FALSE]) 
  b[b<=0] <- NA               
  b <- c(1,b)                 
  a <- cbind(a,b)
  a <- na.omit(a) 
  a <- a[,-c(3),drop=FALSE]         
  return(a)}

vector.base <- function(x,y){
  a <- rep(y,x) 
  b <- seq(1:x) 
  c <- data.frame(x = b, y = a) 
  return(c)}

vector.multi <- function(x,y,z){                                            
  a <- rep(NA, x)
  a[y] <- z       
  a[seq_len(min(y)-1)] <- a[min(y)] 
  if(max(y) < x){a[seq(max(y)+1, x, 1)] <- 0}   
  a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y  
  b <- seq(1:x)                                                     
  c <- data.frame(x = b, z = a)                                     
  return(c)}

vector.multiFinal <- function(x,y){
  vector.multi(x,matrix.validate(x,y)[,1],matrix.validate(x,y)[,2])}

matrix.link <- function(x,y){
  observeEvent(input$periods|input$base_input,{
    updateMatrixInput(session,x,value=matrix(c(input$periods,y),1,2,dimnames=list(NULL, c("y","z"))))})}

# --- Attempt to create function for Reactive code
vectorVariable <- function(x,y){
  reactive({
    if(input$showVectorBtn == 0) vector.base(periods(),x)
    else vector.multiFinal(periods(),matrix.validate(periods(),y))
  })
}

ui <- 
  pageWithSidebar(
    headerPanel("Model"),
    sidebarPanel(
      uiOutput("Panels")),
    mainPanel(
      tabsetPanel(
        tabPanel("Dynamic", value=2,
           actionButton('showVectorPlotBtn','Vector plots'),
           actionButton('showVectorValueBtn','Vector values'),
           uiOutput("vectorTable")),
        id = "tabselected")
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  periods        <-  reactive(input$periods)
  base_input     <-  reactive(input$base_input)
  vector_input   <-  reactive(input$vector_input)
  yld            <-  reactiveValues()
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==2",
        numericInput('begin.bal','',value=100000,step=1000,width = '100%'),
        sliderInput('periods','',min=1,max=120,value=60),
        matrix1.input("base_input"),
        useShinyjs(),
        actionButton('showVectorBtn','Show'), 
        actionButton('hideVectorBtn','Hide'),
        actionButton('resetVectorBtn','Reset'),
        hidden(uiOutput("Vectors"))
      ) # close conditional panel
    ) # close tagList
  }) # close renderUI
  
  renderUI({matrix.link("vector_input",input$base_input[1,1])})
  
  output$Vectors <- renderUI({
    input$resetVectorBtn
    tagList(matrix2.input("vector_input",input$periods,input$base_input[1,1]))
  }) # close render UI
  
  observeEvent(input$showVectorBtn,{shinyjs::show("Vectors")})
  observeEvent(input$hideVectorBtn,{shinyjs::hide("Vectors")})
  
  output$graph1 <- renderPlot(
    plot(if(input$showVectorBtn == 0) vector.base(periods(),input$base_input[1,1])
         else vector.multiFinal(periods(),matrix.validate(periods(),vector_input())),
    ) # close plot
  ) # close render plot
  
  output$table1 <- renderDT({vectorsAll()})
  
  observeEvent(input$showVectorPlotBtn,{yld$showme <- plotOutput("graph1")},ignoreNULL = FALSE)
  observeEvent(input$showVectorValueBtn,{yld$showme <- DTOutput("table1")})
  
  output$vectorTable <- renderUI({yld$showme})
  
# Generates global variables vector.R for testing purposes
  oe1 <- reactive({req(periods(),vector_input())
    if(input$showVectorBtn == 0) vector.base(periods(),input$base_input[1,1])
    else vector.multiFinal(periods(),matrix.validate(periods(),vector_input()))
  })
  observeEvent(oe1(),{vector.R <<- oe1()})
  
  vectorsAll <- reactive({
    cbind(1:periods(),
      if(input$showVectorBtn == 0) vector.base(periods(),input$base_input[1,1])[,2]
      else vector.multiFinal(periods(),matrix.validate(periods(),vector_input()))[,2]
    ) # close cbind
  }) # close reactive
}) # close server

shinyApp(ui, server)

Answer 1

First, you do not need to wrap input$* in reactive() like you did. input$* are already reactive.

periods <- reactive(input$periods)
...

As for your vectorVariable reactive function, in your MWE, x is always input$base_input[1,1] and y is always vector_input() aka input$vector_input . Your vectorVariable would look like this, and should be inside server <- function() {}

vectorVariable <- reactive({
  if(input$showVectorBtn == 0) vector.base(input$periods, input$base_input[1,1])
  else vector.multiFinal(input$periods,matrix.validate(input$periods,input$vector_input))
    })

vectorVariable is called:

output$graph` <- renderPlot(plot(vectorVariable()))
oe1 <- reactive({req(input$periods,input$vector_input)
  vectorVariable()
})
vectorsAll <- reactive({
  cbind(1:input$periods, vectorVariable()[,2])
})

If you need vectorVariable to be more "dynamic", you can use reactiveVal()

x <- reactiveVal()
y <- reactiveVal()

vectorVariable <- reactive({
  if(input$showVectorBtn == 0) vector.base(input$periods, x())
  else vector.multiFinal(input$periods,matrix.validate(input$periods,y()))
    })

And then assign values to x and y somewhere in your code

x(input$base_input[1,1])
y(input$vector_input)

But, do be aware that vectorVariable() might not immediately pick up the new values of x() and y() when you call it.

Answer 2

Please see my comment above responding to rbasa. After further fiddling around, I used the below function, embedded in the server section of the MWE code, to get what was required:

vectorVariable <- function(x,y){
    if(input$showVectorBtn == 0) vector.base(input$periods,x)
    else vector.multiFinal(input$periods,matrix.validate(input$periods,y))}

Then to show the plot, for example, here is what I coded:

output$graph1 <- renderPlot(
    plot(vectorVariable(input$base_input[1,1],vector_input())
    ) # close plot
  ) # close render plot