r - 自定义加载器在输出创建过程开始之前显示 na shiny app

Question

我在下面有一个闪亮的仪表板，如果我在其中提供除默认名称之外的名称consent.name，请提供密码makis并按下Get started 生成的 rmd 输出。正如您将看到的，在创建报告时会显示一条加载消息。问题是在执行任何操作之前会显示此加载消息，这令人困惑。Name只有在和Password输入正确并且Get started actionButton()被推送时，如何才能显示此加载消息？我相信使用 withLoader() 创建的加载消息应该从代码ui的server一部分移到代码的一部分，以便遵循与 rmarkdown 相同的逻辑uiOutput()。

ex.rmd

---
title: "An example Knitr/R Markdown document"
output: pdf_document
---


{r chunk_name, include=FALSE}
x <- rnorm(100)
y <- 2*x + rnorm(100)
cor(x, y)

和应用程序。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(knitr)
library(shinycustomloader)
dbHeader <- dashboardHeaderPlus(
  titleWidth = "0px",
  tags$li(a(
    div(style="display: inline;margin-top:25px; padding: 0px 0px 0px 1250px;vertical-align:top; width: 150px;", actionButton("well", "Welcome")),

  ),
  class = "dropdown")
  
  
)

shinyApp(
  ui = dashboardPagePlus(
    header = dbHeader,
    sidebar = dashboardSidebar(width = "0px",
                               sidebarMenu(id = "sidebar", # id important for updateTabItems
                                           menuItem("Welcome", tabName = "well", icon = icon("house"))
                               )           ),
    body = dashboardBody(
      
      useShinyjs(),
      tags$script(HTML("$('body').addClass('fixed');")),
      
      tags$head(tags$style(".skin-blue .main-header .logo { padding: 0px;}")),
      tabItems(
        tabItem("well",
                fluidRow(),
                tags$hr(),
                tags$hr(),
                fluidRow(
                  fluidRow(textInput("name", label = ("Name"), value = "consent.name")),
                  passwordInput("pwd", "Enter the Database browser password"),
                  withLoader(uiOutput('markdown'),type="html",loader = "loader1"),
                  actionButton("button", "Get started",style='padding:4px; font-size:140%')
                  ))
       
      )
      
      
    )
    
  ),
  server<-shinyServer(function(input, output,session) { 
    hide(selector = "body > div > header > nav > a")
    
    observeEvent(input$button,{
      if (input$name=="consent.name"){
        return(NULL)
      }
      else{
        if(input$pwd=="makis"){
          output$markdown <- renderUI({
            HTML(markdown::markdownToHTML(knit('ex.rmd', quiet = TRUE)))
          })
          
        }
        else{
          return(NULL)
        }
      }
    })
    
  }
  )
)

标签： rshiny