Search code examples
rshinyshiny-reactivity

In R shiny, how to trigger change in a conditional panel rendered in UI after clicking an action button?


This is similar to a post of mine from 3-Sep-2021, except that the prior post addressed a situation where conditional panels were rendered in server section using renderUI. To simplify, I'm moving all conditional panels to UI section and in certain instances what worked for renderUI isn't working for UI. So here goes...

The problem: when running the below MWE code, if the user is in the “Liabilities module” tab (default tab when first invoking) and is (1) currently viewing the Rates values table (table4) in the main panel (after having clicked on "Rates values" radio button on top of main panel), then (2) clicks on the "Mod Liaby" action button in the sidebar panel, and then (3) dismisses/resets the modal dialogue, then (4) the Rates values table remains in the main panel.

Similarly, if user is in “Liabilities module" tab and is (1) currently viewing the liabilities structure table (table3) in the main panel, then (2) clicks on the "Mod Rate" action button in the sidebar panel, and then (3) dismisses/resets the modal dialogue, then (4) the liabilities structure table remains in the main panel.

I'd like a click of "Mod Liaby" action button to immediately cause the liabilities table ("table3") to be rendered in the main panel (behind the modal dialogue), regardless of what was previously in the main panel. Similarly, I'd like a click of "Mod Rate" action button to immediately cause the rates table ("table4") to be rendered in the main panel (behind the modal dialogue), regardless of what was previously in the main panel.

Essentially, I need to trigger some sort of "Go to" function for main panel table rendering after clicking one of the side bar action buttons. I don't know how to do this.

My attempt to do this is flagged below with # ???. My guess is this is a very simple fix but my working knowledge is still limited!! The functions at the top, above UI, can be safely ignored! Also functions like vectorLiabStruct and vectorRates can be ignored, as the issue lies with conditonal panels in UI section and table rendering.

MWE code:

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

mainPanelBtns <- function(x,y,z){radioButtons(inputId=x,label="Model view:",choices= y,selected=z,inline=TRUE)}
matrix3Default <- matrix(c(1,24,0,100), 4, 1,dimnames=list(c('A','B','C','D')))
matrix3Input <- function(x, matrix3Default){matrixInput(x,label='Input:',value=matrix3Default,class= 'numeric')} 
matrix3RowHeaders <- function(){c('A','B','C','D')}
matrix4Default <- matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))
matrix4Input <- function(x,matrix4Input){matrixInput(x,value = matrix4Input,class = "numeric")}
vectorBaseRate <- function(x,y){
    a <- rep(y,x)
    b <- seq(1:x)
    c <- data.frame(x = b, y = a)
    return(c)}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow("Base Input Panel"),
      conditionalPanel(condition="input.tabselected==4",actionButton('modLiab','Mod Liaby')),
      conditionalPanel(condition="input.tabselected==4||input.tabselected==5",actionButton('modRates','Mod Rate'))
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
          tabPanel("Liabilities module", value=4,
             mainPanelBtns('mainPanelBtnTab4',c('Liabilities','Rates values'),'Liabilities'),
             conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Liabilities'", tableOutput("table3")),
             conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Rates values'", tableOutput("table4"))
          ), # close tab panel
          tabPanel("Interest rates", value=5,
             mainPanelBtns('mainPanelBtnTab5',c('Rates values'),'Rates values'), 
             conditionalPanel(condition = "input.mainPanelBtnTab5 == 'Rates values'", tableOutput("table5"))
          ), # close tab panel
        id = "tabselected"
      ))) # close tabset panel, main panel, and page with sidebar
    
server <- function(input,output,session)({
  
  rv3        <- reactiveValues( # << rv3 used for matrix 3 (liability structure) inputs
    mat3      = matrix3Input('matrix3',matrix3Default),
    input     = matrix3Default
  ) # close reactive values
  
  matrix4   <- reactive(input$matrix4)
  baseRate  <- function(){vectorBaseRate(60,input$matrix4[1,1])} 
  
  vectorLiabStruct <- reactive({
    if(!isTruthy(input$modLiab)){ 
      df <- matrix3Default
      rownames(df) <- matrix3RowHeaders()}
    else{ 
      req(input$matrix3) 
      rv3$mat3 <- matrix3Input('matrix3',input$matrix3) 
      df <- input$matrix3
      rownames(df) <- matrix3RowHeaders()
      rv3$input <- df
    } # close else
    df})
  
  output$table3 <- renderTable({
    if(!isTruthy(input$modLiab)){ 
      df <- matrix3Default
      rownames(df) <- matrix3RowHeaders()}
    else{ 
      req(input$matrix3) 
      rv3$mat3 <- matrix3Input('matrix3',input$matrix3) 
      df <- input$matrix3
      rownames(df) <- matrix3RowHeaders()
      rv3$input <- df
    } # close else
    df},rownames=TRUE, colnames=TRUE) 
  
  vectorRates <- reactive({
    if (is.null(input$modRates)){df <- NULL}
    else {
      if(input$modRates < 1){df <- cbind(Period = 1:60,BaseRate = 0.2)}
      else {
        req(input$matrix4)
        df <- cbind(Period = 1:60,BaseRate = baseRate()[,2])
      } # close 2nd else
    } # close 1st else
    df}) 
  
  observeEvent(input$modLiab,{ 
    showModal(modalDialog(rv3$mat3,footer=tagList(actionButton("resetLiab","Reset"),modalButton("Close"))))
    tableOutput("table3") # ???
    })
  
  observeEvent(input$resetLiab, {updateMatrixInput(session,'matrix3', matrix3Default)})
  observeEvent(input$resetRates, {updateMatrixInput(session,'matrix4', matrix4Default)})
  
  output$table5<-output$table4<-renderTable({vectorRates()})
  
  observeEvent(input$modRates,
               {showModal(modalDialog(
                 matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
                 useShinyjs(),
                 footer = tagList(actionButton("resetRates","Reset"),modalButton("Close"))))
               } # close modalDialog
  ) # close observeEvent
  
}) # close server

shinyApp(ui, server)

Solution

  • Once again I'm not entirely sure if I understood your problem correctly, but please check the following code and see the updateRadioButtons calls:

    library(shiny)
    library(shinyMatrix)
    library(shinyjs)
    
    mainPanelBtns <- function(x, y, z) {
      radioButtons(
        inputId = x,
        label = "Model view:",
        choices = y,
        selected = z,
        inline = TRUE
      )
    }
    
    matrix3Default <- matrix(c(1, 24, 0, 100), 4, 1, dimnames = list(c('A', 'B', 'C', 'D')))
    
    matrix3Input <- function(x, matrix3Default) {
      matrixInput(x,
                  label = 'Input:',
                  value = matrix3Default,
                  class = 'numeric')
    }
    
    matrix3RowHeaders <- function() {
      c('A', 'B', 'C', 'D')
    }
    
    matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
    
    matrix4Input <- function(x, matrix4Input) {
      matrixInput(x, value = matrix4Input, class = "numeric")
    }
    
    vectorBaseRate <- function(x, y) {
      a <- rep(y, x)
      b <- seq(1:x)
      c <- data.frame(x = b, y = a)
      return(c)
    }
    
    ui <- pageWithSidebar(
      headerPanel("Model..."),
      sidebarPanel(
        fluidRow("Base Input Panel"),
        conditionalPanel(condition = "input.tabselected==4", actionButton('modLiab', 'Mod Liaby')),
        conditionalPanel(condition = "input.tabselected==4||input.tabselected==5", actionButton('modRates', 'Mod Rate'))
      ), # close sidebar panel
      mainPanel(
        useShinyjs(),
        tabsetPanel(
          tabPanel(
            "Liabilities module",
            value = 4,
            mainPanelBtns(
              'mainPanelBtnTab4',
              c('Liabilities', 'Rates values'),
              'Liabilities'
            ),
            conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Liabilities'", tableOutput("table3")),
            conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Rates values'", tableOutput("table4"))
          ), # close tab panel
          tabPanel(
            "Interest rates",
            value = 5,
            mainPanelBtns('mainPanelBtnTab5', c('Rates values'), 'Rates values'),
            conditionalPanel(condition = "input.mainPanelBtnTab5 == 'Rates values'", tableOutput("table5"))
          ), # close tab panel
          id = "tabselected"
        ))
    ) # close tabset panel, main panel, and page with sidebar
    
    server <- function(input, output, session){
      rv3 <- reactiveValues(
        # << rv3 used for matrix 3 (liability structure) inputs
        mat3      = matrix3Input('matrix3', matrix3Default),
        input     = matrix3Default
      ) # close reactive values
      
      matrix4   <- reactive(input$matrix4)
      baseRate  <- function() {
        vectorBaseRate(60, input$matrix4[1, 1])
      }
      
      vectorLiabStruct <- reactive({
        if (!isTruthy(input$modLiab)) {
          df <- matrix3Default
          rownames(df) <- matrix3RowHeaders()
        } else{
          req(input$matrix3)
          rv3$mat3 <- matrix3Input('matrix3', input$matrix3)
          df <- input$matrix3
          rownames(df) <- matrix3RowHeaders()
          rv3$input <- df
        } # close else
        df
      })
      
      output$table3 <- renderTable({
        if (!isTruthy(input$modLiab)) {
          df <- matrix3Default
          rownames(df) <- matrix3RowHeaders()
        } else{
          req(input$matrix3)
          rv3$mat3 <- matrix3Input('matrix3', input$matrix3)
          df <- input$matrix3
          rownames(df) <- matrix3RowHeaders()
          rv3$input <- df
        } # close else
        df
      }, rownames = TRUE, colnames = TRUE)
      
      vectorRates <- reactive({
        if (is.null(input$modRates)) {
          df <- NULL
        } else {
          if (input$modRates < 1) {
            df <- cbind(Period = 1:60, BaseRate = 0.2)
          } else {
            req(input$matrix4)
            df <- cbind(Period = 1:60, BaseRate = baseRate()[, 2])
          } # close 2nd else
        } # close 1st else
        df
      })
      
      observeEvent(input$modLiab, {
        updateRadioButtons(inputId = "mainPanelBtnTab4", selected = "Liabilities")
        updateRadioButtons(inputId = "mainPanelBtnTab5", selected = "Liabilities")
        showModal(modalDialog(rv3$mat3, footer = tagList(
          actionButton("resetLiab", "Reset"), modalButton("Close")
        )))
      })
      
      observeEvent(input$resetLiab, {
        updateMatrixInput(session, 'matrix3', matrix3Default)
      })
      observeEvent(input$resetRates, {
        updateMatrixInput(session, 'matrix4', matrix4Default)
      })
      
      output$table5 <- output$table4 <- renderTable({
        vectorRates()
      })
      
      observeEvent(input$modRates, {
        updateRadioButtons(inputId = "mainPanelBtnTab4", selected = "Rates values")
        updateRadioButtons(inputId = "mainPanelBtnTab5", selected = "Rates values")
        showModal(modalDialog(
          matrix4Input("matrix4", 
                       if (is.null(input$matrix4)){
                         matrix4Default
                       } else {
                         input$matrix4
                       }),
          footer = tagList(
            actionButton("resetRates", "Reset"),
            modalButton("Close")
          )
        ))
      } # close modalDialog
      ) # close observeEvent
    } # close server
    
    shinyApp(ui, server)
    

    Edit: moved useShinyjs() to the UI - see ?useShinyjs():

    This function must be called from a Shiny app's UI in order for all other shinyjs functions to work.