简体   繁体   中英

In R Shiny App that uses modal dialog for user inputs, how to show default table when first invoking?

I'm trying to use a modal dialog box for user inputs since the fields of inputs are extensive in the full App. I almost have it working, but I'm not able to show the default table in the main panel when first invoking the App. I would like the default table (60 rows of 2 columns, 1st column labeled 1-60 and 2nd columns with values of 0.20) to appear when first invoking the App. Instead in the main panel I get the error message shown in the first image below. However, when I click the "Input Liabilities" action button which pulls up the modal dialog box with user input matrix grid, then the default table in the main panel correctly appears (whether or not the user has input into the grid) as shown in the second image, at the very bottom.

How do I correct this so the default table appears in the main panel when invoking the App?

Btw I just moved the user input matrix grid from a sidebar panel to modal dialog, and the default table correctly appeared in the main panel when first invoking the App when user input grid was in the sidebar panel. Now that I moved the user input matrix grid into the modal dialog (per the MWE code below), the default table no longer correctly renders until the modal dialog is invoked. So the problem must lie in my use of modal dialog.

Below is the MWE code:

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

button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}

matrix1Input <- 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")}

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

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

vectorPlot <- function(w,x,y,z){plot(w,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")),
    # Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
      uiOutput("Panels") 
    ), # close sidebar panel
    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(
                   button2('showVectorValueBtn','Vector values'),
                   button2('showVectorPlotBtn','Vector plots'),
                 ), # close fluid row
                 
                 div(style = "margin-top: 5px"),
                 
                 # Shows outputs on each page of main panel   
                 uiOutput('showResults')), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  base_input  <- reactive(input$base_input)
  showResults <- reactiveValues()

  yield   <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
  
  # --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ------------>
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==4",
        actionButton('showLiabilityGrid','Input Liabilities',style='width:100%;background-color:LightGrey'),
        setShadow(id='showLiabilityGrid'),
        div(style = "margin-bottom: 10px"),
      ), # close conditional panel
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    ) # close tagList
  }) # close renderUI
  
  # --- Below produces vector values as default view when first invoking App --------------------------->
  vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))}) # Produces vector values
  output$table1 <- renderTable({vectorsAll()})
  
  # --- Below produces vector values after clicking "Vector Values" button; see above for pre-click ---->
  observeEvent(input$showVectorValueBtn,
               {showResults$showme <-
                 tagList(tableOutput("table1"))
               },ignoreNULL = FALSE)

  # --- Below produces vector plots -------------------------------------------------------------------->   
  output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
  observeEvent(input$showVectorPlotBtn,{showResults$showme <- plotOutput("graph1")})
  
  # --- Below sends both vector plots and vector values to UI section above ---------------------------->
  output$showResults <- renderUI({showResults$showme})

  # --- Below for modal dialog inputs ------------------------------------------------------------------>
  observeEvent(input$showLiabilityGrid,
               {showModal(modalDialog(
                 matrix1Input("base_input"),
                 div(style = "margin-top: 0px"),
                 useShinyjs(),
               ) # close modalDialog
               ) # close showModal
               } # close showModal function
  ) # close observeEvent
  
}) # close server

shinyApp(ui, server)

在此处输入图像描述

在此处输入图像描述

Your vectorsAll object is not defined before you click on the actionButton "Input Liabilities". Therefore, you should try

vectorsAll <- reactive({
    if (is.null(input$showLiabilityGrid ) ) {
      df <- NULL
    }else {
      if (input$showLiabilityGrid < 1) {
        df <- cbind(Period = 1:60,Yld_Rate = pct(0.2))  ## define what you want to display by default
      }else {
        req(yield())
        df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
      } 
    } 
    df
  }) 

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM