The below MWE code generates an expandable matrix (input grid) in R Shiny inside a modal dialog box, for user inputs. Action button "Modify" pulls up the default input grid which the user can modify (change default values, add/delete columns, etc.), "Show" and "Hide" show/hide the most recently updated input grid, and "Reset" returns input grid values to default values. All the above works well.
However, is it possible to automatically generate matrix column headers when the matrix is expandable, such as in this matrix function? So for example I have the first default column labeled "Series 1". I'd like any 2nd column that's added to be automatically labeled "Series 2", 3rd column labeled "Series 3", etc.; which the user would have the option to over-write on a column-by-column basis as it is currently set in shinyMatrix.
Below you'll see the line of code colnames(default_mat) <- paste0("Series ", 1:ncol(default_mat))
which works for generating the column header for the first default column. I've been trying to work this into the reactive sections of code in order to automatically generate headers for additional columns with no luck yet. User should have the ability to over-write this default auto header.
MWE code:
library(shiny)
library(shinyMatrix)
library(shinyjs)
default_mat <- matrix(c(1,24,0,1),4,1,dimnames=list(c("A","B","C","D"),NULL))
colnames(default_mat) <- paste0("Series ", 1:ncol(default_mat))
matrix3Input <- function(x, default_mat){
matrixInput(x,
label = 'Series terms:',
value = default_mat,
rows = list(extend = FALSE,names = TRUE),
cols = list(extend = TRUE,names = TRUE,editableNames = TRUE,delete = TRUE),
class = "numeric") # close matrix input
} # close function
ui <- fluidPage(
useShinyjs(),
titlePanel("Inputs"),
fluidRow(actionButton("modify","Modify"),
actionButton("show","Show"),
actionButton("hide","Hide"),
actionButton("reset","Reset"),
tableOutput("table2")
) # close fluid row
) # close fluid page
server <- function(input, output, session){
rv <- reactiveValues(mat = matrix3Input("matrix", default_mat),
input = default_mat,
name = colnames(default_mat)
) # close reactive values
hide("table2")
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat,
tableOutput("table1"))
)
hide("table2")
})
output$table1 <- renderTable({
rv$mat <- matrix3Input("matrix", input$matrix)
rv$input <- input$matrix
input$matrix
}, rownames = TRUE)
observeEvent(input$show,{
show("table2")
})
observeEvent(input$hide, hide("table2"))
observeEvent(input$reset,{
hide("table2")
rv$input <- default_mat
rv$mat <- matrix3Input("matrix", default_mat)
}) # close observe event
output$table2 <- renderTable({
rv$input
}, rownames = TRUE)
} # close server
shinyApp(ui, server)
Solved as follows:
observe
functionobserve
function, change the colnames
of the input matrix given by input$matrix
updateMatrixInput
. Used the isolate
function to avoid an endless cycle of change and refreshRevised MWE reflecting the solution, with changes from original MWE shown below marked with # << ADDED...
, # << DELETED...
, and similar notations:
library(shiny)
library(shinyMatrix)
library(shinyjs)
default_mat <- matrix(c(1,24,0,1),4,1,dimnames=list(c("A","B","C","D"),c(1))) # << ADDED c(1)
# colnames(default_mat)... << DELETED this function that appeared in original MWE
matrix3Input <- function(x, default_mat){
matrixInput(x,
label = 'Series terms:',
value = default_mat,
rows = list(extend = FALSE,names = TRUE),
cols = list(extend = TRUE,names = TRUE,editableNames = TRUE,delete = TRUE),
class = "numeric") # close matrix input
}
ui <- fluidPage(
useShinyjs(),
titlePanel("Inputs"),
fluidRow(actionButton("modify","Modify"),
actionButton("show","Show"),
actionButton("hide","Hide"),
actionButton("reset","Reset"),
tableOutput("table2")
)
)
server <- function(input, output, session){
matrix <- reactive(input$matrix) # << ADDED REACTIVE FOR "matrix"
rv <- reactiveValues(mat = matrix3Input("matrix", default_mat), input = default_mat)
hide("table2")
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat,
tableOutput("table1"))
)
hide("table2")
})
# ADDED BELOW "OBSERVE", LINKs TO MATRIX INPUT >>
observe({
req(matrix())
mm <- input$matrix
colnames(mm) <- 1:ncol(mm)
isolate(updateMatrixInput(session, "matrix", mm))
})
output$table1 <- renderTable({
rv$mat <- matrix3Input("matrix", input$matrix)
rv$input <- input$matrix
input$matrix
}, rownames = TRUE)
observeEvent(input$show,{
show("table2")
})
observeEvent(input$hide, hide("table2"))
observeEvent(input$reset,{
hide("table2")
rv$input <- default_mat
rv$mat <- matrix3Input("matrix", default_mat)
})
output$table2 <- renderTable({
rv$input
}, rownames = TRUE)
}
shinyApp(ui, server)
Thanks to Jan for his posted answer to similar and simplified CuriousJorge question on 29 Sep 2021 which set me on the course for this solution!