The below R Shiny MWE code works as intended. I created a custom function matrix3Input as shown below, and to generate the desired matrix output column and row headers that custom function is seeded with another custom function matrix3Headers, the values in matrix3Default dataframe, and the colnames... function shown below (we'll call these 3 functions/dataframes "Seeds").

I erroneously reordered the Seeds and subsequently had a hard time debugging the larger code this MWE is summarized from. (For some weird reason, the errors only showed after rebooting my computer - restarting R never cleared all functions from memory and I was unable to detect the errors until I had moved very far along in the coding). Btw I successfully resisted the temptation to come to Stack Overflow to detect the errors!! Who likes to debug?

So as you can see, as drafted, matrix3Headers must come first, matrix3Default next, and colnames last, for matrix3Input to work.

Is there a more robust way to write these functions while maintaining understandability? As drafted it's bug-prone.

MWE code:

library(shiny)
library(shinyMatrix)

### The 3 items below must be maintained in order to correctly run matrix3Input ###
matrix3Headers <- function(){c('A','B','C','D')}                                  #
matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(), NULL)) #
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))              #
### End of 3 items ################################################################

matrix3Input <- function(x, matrix3Default){
  matrixInput(x,
              label =  'Input terms:',
              value =  matrix3Default, 
              rows  =  list(extend=FALSE,names=TRUE), 
              cols  =  list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
              class =  'numeric'
  ) # close matrix input
} # close function

ui <- fluidPage(titlePanel('Inputs'),fluidRow(actionButton('modify','Modify'),tableOutput('table3')))

server <- function(input, output, session){
  
  rv <- reactiveValues(
    mat3=matrix3Input('matrix3',matrix3Default),
    input=matrix3Default,
    colHeader = colnames(input)
  ) # close reactive values
  
  observeEvent(input$modify,{showModal(modalDialog(rv$mat3))})
  
  output$table3 <- renderTable({
    if(!isTruthy(input$modify)){ 
      df <- matrix3Default
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
      }
    else{ 
      req(input$matrix3) 
      rv$mat3 <- matrix3Input('matrix3',input$matrix3) 
      df <- input$matrix3
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
      rv$input <- df
    } # close else
    df
  },rownames=TRUE, colnames=TRUE) # close output$table3
  
} # close server

shinyApp(ui, server)

CodePudding user response：

Here is my code review:

• There is no need to wrap matrix3Headers in a function with zero options
• rm(list=ls()) at the beginning will enforce to start always with an empty environment for reproducibility
• comments on closing brackets are redundant. Matching brackets will be highlighted by the IDE anyways
• InputId can be explicitly called (no need to call it x)
• matrix3Default can be easily cretaed using a data.frame
• Avoid negatives e.g. use if (isTruthy(input$modify)) instead and switch the else block

# always start with an empty enviornment for reproducibility
rm(list = ls())

library(shiny)
library(shinyMatrix)

# Default matrix for init
matrix3DefaultRownames <- c("A", "B", "C", "D")
matrix3Default <- data.frame(`Series 1` = c(1, 24, 0, 100), row.names = matrix3DefaultRownames) %>% as.matrix()

matrix3Input <- function(inputId, matrix3Default) {
  matrixInput(
    inputId = inputId,
    label = "Input terms:",
    value = matrix3Default,
    rows = list(extend = FALSE, names = TRUE),
    cols = list(extend = TRUE, names = TRUE, editableNames = FALSE, delete = TRUE),
    class = "numeric"
  )
}

ui <- fluidPage(titlePanel("Inputs"), fluidRow(actionButton("modify", "Modify"), tableOutput("table3")))

server <- function(input, output, session) {
  rv <- reactiveValues(
    mat3 = matrix3Input("matrix3", matrix3Default),
    input = matrix3Default,
    colHeader = colnames(input)
  )

  observeEvent(input$modify, {
    showModal(modalDialog(rv$mat3))
  })

  output$table3 <- renderTable(
    {
      if (isTruthy(input$modify)) {
        req(input$matrix3)
        
        df <- input$matrix3
        rv$mat3 <- matrix3Input("matrix3", df)
        colnames(df) <- paste("Series", 1:ncol(df))
        rownames(df) <- matrix3DefaultRownames
        rv$input <- df
      } else {
        df <- matrix3Default
        
        # there is the function ncol so no need for dim[2]
        colnames(df) <- paste("Series", 1:ncol(df))
        rownames(df) <- matrix3DefaultRownames
      }
      
      df
    },
    rownames = TRUE,
    colnames = TRUE
  )
}

shinyApp(ui, server)