在 R Shiny 使用模态对话框进行用户输入的 App 中，如何在首次调用时显示默认表格？

Question

我正在尝试为用户输入使用模式对话框，因为输入字段在完整的应用程序中很广泛。 我几乎可以正常工作，但在首次调用该应用程序时无法在主面板中显示默认表格。 我希望默认表（60 行 2 列，第一列标记为 1-60，第二列的值为 0.20）在首次调用应用程序时出现。 相反，在主面板中，我收到了下面第一张图片中显示的错误消息。 但是，当我单击“输入负债”操作按钮以拉出带有用户输入矩阵网格的模态对话框时，主面板中的默认表会正确显示（无论用户是否已输入网格），如下所示第二张图片，在最底部。

如何更正此问题，以便在调用应用程序时默认表出现在主面板中？

顺便说一句，我只是将用户输入矩阵网格从侧边栏面板移动到模式对话框，当用户输入网格位于侧边栏面板中时，当第一次调用应用程序时，默认表格正确显示在主面板中。 现在我将用户输入矩阵网格移动到模态对话框中（根据下面的 MWE 代码），在调用模态对话框之前，默认表不再正确呈现。 所以问题一定出在我使用模态对话框上。

下面是 MWE 代码：

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)

Answer 1

在单击操作actionButton “输入负债”之前，您的vectorsAll object 未定义。 因此，你应该尝试

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