根据闪亮仪表板的其他选项卡中的操作在选项卡中显示下载按钮

Question

我在下面有一个闪亮的仪表板，如果我在其中给出除默认 consent.name 之外的名称，然后按 Continue 并将移动到 tabItem Password 中，我在其中输入密码 makis 并按Get started 操作按钮在 Welcome 或 Run Project 选项卡中生成 rmd 输出。然后用户可以按'Generate report' 以将其下载为pdf。基本上我想要做的是仅在报告创建并显示在正文中时才显示'Generate report' downloadButton()，否则它没有意义并且令人困惑。我尝试应用我也用于创建报告的observeEvent() 方法，但它不起作用，downloadButton() 始终存在。

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)
mytitle <- paste0("Life, Death & Statins")
dbHeader <- dashboardHeaderPlus(
  titleWidth = "0px",
  tags$li(a(
    
    div(style="display: inline;margin-top:-35px; padding: 0px 90px 0px 1250px ;font-size: 58px ;color: black;font-family:Times-New Roman;font-weight: bold; width: 500px;",HTML(mytitle)),
    div(style="display: inline;margin-top:25px; padding: 0px 0px 0px 1250px;vertical-align:top; width: 150px;", actionButton("well", "Welcome")),
    div(style="display: inline;padding: 0px 0px 0px 0px;vertical-align:top; width: 150px;", actionButton("conse", "Consent")),
    div(style="display: inline;padding: 0px 0px 0px 0px;vertical-align:top; width: 150px;", actionButton("pswd", "Password")),
    div(style="display: inline;padding: 0px 0px 0px 0px;vertical-align:top; width: 150px;", actionButton("rp", "Run Project")),
    div(style="display: inline;padding: 0px 0px 0px 0px;vertical-align:top; width: 150px;", actionButton("res", "Results"))
    
  ),
  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")),
                                           menuItem("Consent", tabName = "conse", icon = icon("line-chart")),
                                           menuItem("Password", tabName = "pswd", icon = icon("house")),
                                           menuItem("Run Project", tabName = "rp", icon = icon("table")),
                                           menuItem("Results", tabName = "res", icon = icon("line-chart"))
                               )           ),
    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(
                  column(5,),
                  column(6,
                         actionButton("button", "Get started",style='padding:4px; font-size:140%')))),
        
        tabItem("conse",
                tags$hr(),
                fluidRow(column(3,textInput("name", label = ("Name"), value = "consent.name"))),
                fluidRow(column(3,actionButton('continue', "Continue",style='padding:4px; font-size:180%')))
        ),
        tabItem("pswd",
                tags$hr(),
                tags$hr(),
                fluidRow(
                  column(5,),
                  column(6,passwordInput("pwd", "Enter the Database browser password")
                         
                         
                  )) ),
        tabItem("rp"),
        tabItem("res",
                tags$hr(),
                tags$hr(),
                
                fluidRow(
                  column(3,
                         uiOutput("downloadbtn")
                  ),
                  column(6,
                         uiOutput('markdown'))))
      ),
      
      
      
    )
    
  ),
  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)
        }
      }
    })
    
    
    observeEvent(input$well, {
      updateTabItems(session, "sidebar", "well")
    })
    observeEvent(input$conse, {
      updateTabItems(session, "sidebar", "conse")
    })
    observeEvent(input$pswd, {
      updateTabItems(session, "sidebar", "pswd")
    })
    observeEvent(input$rp, {
      updateTabItems(session, "sidebar", "well")
    })
    observeEvent(input$res, {
      updateTabItems(session, "sidebar", "res")
    })
    
    observeEvent(input$button, {
      if (input$name=="consent.name") {
        updateTabItems(session, "sidebar",
                       selected = "conse")
      }
      else{
        if(input$pwd==""){
          updateTabItems(session, "sidebar",
                         selected = "pswd")
        }
        else if(input$pwd=="makis"){
          updateTabItems(session, "sidebar",
                         selected = "res")
        }
        else{
          updateTabItems(session, "sidebar",
                         selected = "pswd")
        }
        
      }
      
    })
    
    observeEvent(input$continue, {
      if (input$name=="consent.name") {
        updateTabItems(session, "sidebar",
                       selected = "conse")
      }
      else{
        if(input$pwd==""){
          updateTabItems(session, "sidebar",
                         selected = "pswd")
        }
        else if(input$pwd=="makis"){
          updateTabItems(session, "sidebar",
                         selected = "res")
        }
        else{
          updateTabItems(session, "sidebar",
                         selected = "pswd")
        }
        
      }
      
    })
    
    output$downloadbtn <- renderUI({
      if (input$pwd=="makis" & input$button>0 ) { ##  condition under which you would like to display download button
        downloadButton("report", "Generate report",style='padding:4px; font-size:180%')
      }else{
        return(NULL)
      }
    })
    
    observeEvent(input$report,{
      output$report <- downloadHandler(
        # For PDF output, change this to "report.pdf"
        filename = "report.pdf",
        content = function(file) {
          
          tempReport <- file.path(tempdir(), "ex.Rmd")
          file.copy("ex.Rmd", tempReport, overwrite = TRUE)
          
          rmarkdown::render(tempReport, output_file = file,
                            envir = new.env(parent = globalenv())
          )
        }
      )
    })
  }
  )
)

Answer 1

一种方法是在服务器端使用renderUI 来显示downloadButton。然后，您可以使用要显示“生成报告”按钮的条件。您需要在ui 中将downloadButton 替换为uiOutput("downloadbtn")。在服务器上试试这个。

output$downloadbtn <- renderUI({
      if (input$pwd=="makis" & input$button>0 ) { ##  condition under which you would like to display download button
        
        div(style="display: block; padding: 5px 10px 15px 10px ;",
            downloadButton("report",
                         HTML(" PDF"),
                         style = "fill",
                         color = "danger",
                         size = "lg",
                         block = TRUE,
                         no_outline = TRUE
            ) )
      }else{
        return(NULL)
      }
    })
    
    observe({
      if (input$name=="consent.name"){
        return(NULL)
      }
      else{
        if(input$pwd=="makis"){
          
          output$report <- downloadHandler(
            
            filename = "report.pdf",
            content = function(file) {
              src <- normalizePath('ex.Rmd')
              
              # temporarily switch to the temp dir, in case you do not have write
              # permission to the current working directory
              owd <- setwd(tempdir())
              on.exit(setwd(owd))
              file.copy(src, 'ex.Rmd', overwrite = TRUE)
              
              library(rmarkdown)
              out <- render(input = 'ex.Rmd', 
                            output_format = pdf_document(), 
                            params = list(data = data)
              )
              file.rename(out, file)
              
            }
          )
        }
        else{
          return(NULL)
        }
      }
    })