In R Shiny, how to change default view in main panel?

The following almost-MWE code works fine, except that the table showing in the first image below is what appears by default in the main panel when clicking on the "Liabilities module" tab. Instead I'd like to have the table shown in the second image below, resulting when the user clicks on the "Liabilities" button at the top of the main panel in that same "Liabilities module" tab, to appear in the main panel by default when first invoking the App (and going to "Liabilities module").

My questions are:

  1. What is it in the below code that currently sets the default view (of the rates table, table4) in that Liabilities Module?
  2. How do I change the below code so that the liabilities structure table (table3) appears as the default view when opening "Liabilities module" tab?

Quick usage note: clicking on the "Modify..." action buttons in the sidebar panel of Liabilities module pulls up modal dialogue boxes for user inputs into table3 and table4. These inputs are reactively (instantly) reflected in the table3 and table4 outputs.

Almost-MWE code:

library(shiny);library(shinyMatrix);library(shinyjs);library(shinyWidgets)

colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))

matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(), NULL))

matrix3Headers <- function(){c('A','B','C','D')}

matrix3Input <- function(x, matrix3Default){
  matrixInput(x,
              label =  'Input series terms into below grid:',
              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

matrix4Default <- matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))

matrix4Input <- function(x,matrix4Input){
  matrixInput(x, 
              value = matrix4Input,
              rows = list(extend=FALSE,names=TRUE),
              cols = list(extend=FALSE,names=FALSE,editableNames=FALSE),
              class = "numeric")}

pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage

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

vectorBaseRatePlot <- function(w,x,y,z){
  plot(w[,1],sapply(w[,2], function(x)gsub("%","",x)),main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
                        style="margin-top:-15px;margin-bottom:5px")),
      uiOutput("Panels") 
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("By balances", value=2),
        tabPanel("By accounts", value=3), 
        tabPanel("Liabilities module", value=4,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   actionButton('showLiabStructBtn','Liabilities'),
                   actionButton('showRatesValueBtn','Rates values'),
                   actionButton('showRatesPlotBtn','Rates plots'),
                 ), # close fluid row
                 div(style = "margin-top: 5px"),
                 uiOutput('showResults')), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  rates_input <- reactive(input$rates_input)
  showResults <- reactiveValues()
  baseRate    <- function(){vectorBaseRate(60,input$rates_input[1,1])} # Must remain in server section
  rv          <- reactiveValues( 
                  mat3=matrix3Input('matrix3',matrix3Default),
                  input=matrix3Default,
                  colHeader = colnames(input)
                ) # close reactive values
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==4",
        actionButton('modLiabStruct','Modify Liabilities Structure',
                     style='width:100%;background-color:LightGrey'
        ),
        div(style = "margin-bottom: 10px"),
        actionButton('modRates','Modify Rates and Coupons',
                     style='width:100%;background-color:LightGrey'
        ),
        div(style = "margin-bottom: 10px"),
        setShadow(id='modLiabStruct'),
        setShadow(id='modRates')
      ), # close conditional panel
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    ) # close tagList
  }) # close renderUI
  
  vectorRates <- reactive({
    if (is.null(input$modRates)){df <- NULL}
    else {
      if(input$modRates < 1){df <- cbind(Period = 1:60,BaseRate = pct(0.2))}
      else {
        req(input$rates_input)
        df <- cbind(Period = 1:60,BaseRate = pct(baseRate()[,2]))
      } # close 2nd else
    } # close 1st else
    df
  }) # close reactive
  
  output$table4 <- renderTable({vectorRates()})
  
  vectorLiabStruct <- reactive({
    if(!isTruthy(input$modLiabStruct)){ # << Generates default table when first invoking the App
      df <- matrix3Default
      df
      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
  })
  
  output$table3 <- renderTable({vectorLiabStruct()})
  
  output$table3 <- renderTable({
    if(!isTruthy(input$modLiabStruct)){ # << Generates default table when first invoking the App
      df <- matrix3Default
      df
      n <- dim(df)[2]
      colnames(df) <- paste("Series", 1:n)
      rownames(df) <- matrix3Headers()
    }
    else{ 
      req(input$matrix3) 
      rv$mat3 <- matrix3Input('matrix3',input$matrix3) # << Any live modifications to the matrix in the modal box are reflected in table3 thanks to the reactivity, and stored in the rv$mat3 reactiveValues() (with the rv$mat3 <- matrix3Input('matrix3',input$matrix3) line)
      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
  
  observeEvent(input$modLiabStruct,{ 
    showModal(modalDialog( 
      rv$mat3
    )) # close shown modal and modal dialog
  }) # close observe event
  
  observeEvent(input$showLiabStructBtn,
               {showResults$showme <- tagList(tableOutput("table3"))},ignoreNULL = FALSE)  
  
  observeEvent(input$showRatesValueBtn,
               {showResults$showme <- tagList(tableOutput("table4"))},ignoreNULL = FALSE)
  
  output$graph1 <-renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
  
  observeEvent(input$showRatesPlotBtn,{showResults$showme <- plotOutput("graph1")})
  
  output$showResults <- renderUI({showResults$showme})
  
  observeEvent(input$modRates,
               {showModal(modalDialog(
                 matrix4Input("rates_input",if(is.null(input$rates_input)) matrix4Default else input$rates_input),
                 div(style = "margin-top: 0px"),
                 useShinyjs(),
               ))}
  ) # close observeEvent
  
}) # close server

shinyApp(ui, server)

enter image description here

enter image description here

Upvotes: 0

Views: 218

Answers (1)

YBS
YBS

Reputation: 21349

The following should work.

  observeEvent(input$showLiabStructBtn,
               {showResults$showme <- tagList(tableOutput("table3"))},ignoreNULL = FALSE)  
  
  observeEvent(input$showRatesValueBtn,
               {showResults$showme <- tagList(tableOutput("table4"))},ignoreNULL = TRUE)

Upvotes: 1

Related Questions