Warm tip: This article is reproduced from serverfault.com, please click
r shiny

r-根据 shiny dashboard 其他选项卡中的操作在选项卡中显示下载按钮

(r - Display download button in a tab based on actions in other tabs of a shiny dashboard)

发布于 2020-11-27 23:36:14

我下面有一个 shiny 的 dashboard ，如果我提供除default以外的其他名称consent.name，请按，然后Continue将其移动到Password我输入密码makis的Get startedtabItem中，然后按Welcome或Run Projecttab中的actionbutton，生成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())
          )
        }
      )
    })
  }
  )
)
Questioner
firmo23
Viewed
0
分享
3,600 2020-11-29 10:53:31

一种方法是renderUI在服务器端使用来显示downloadButton。然后，你可以使用要显示“生成报告”按钮的条件。你需要更换downloadButton同uiOutput("downloadbtn")在ui。在服务器上尝试一下。

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)
        }
      }
    })
firmo23 2020-11-28 01:00:03

以及如何与downloadhandler（）连接？

firmo23 2020-11-28 11:40:53

我根据您的方法进行了编辑，但我认为该按钮现在无法正常工作。

YBS 2020-11-28 13:01:51

请将该语句if (input$pwd=="makis" & input$button>0 ) {...中的条件修改为希望显示下载按钮的条件。

firmo23 2020-11-28 14:44:01

但是为什么当我按下下载按钮时，无论何时显示该按钮，它都不再下载？

YBS 2020-11-28 18:15:54

请尝试更新的代码。

热门github

1
Implementation of paper - YOLOv9: Learning What You Want to Learn Using Programmable Gradient Information (翻译：论文实现——YOLOv9: Learning What You Want to Learn using Programmable Gradient Information（利用可编程梯度信息学习您想学的内容）)
2
A Windows and Office activator using HWID / Ohook / KMS38 / Online KMS activation methods, with a focus on open-source code and fewer antivirus detections. (翻译：使用 HWID / KMS38 / Online KMS 激活方法激活 Microsoft 产品的脚本集合，重点是开源代码、较少的防病毒检测和用户友好性。)
3
Get up and running with Llama 2, Mistral, Gemma, and other large language models. (翻译：启动并运行 Llama 2、Mistral、Gemma 和其他大型语言模型。)
4
该项目可以让你通过订阅的方式使用Cloudflare WARP+，自动获取流量。This project enables you to use Cloudflare WARP+ through subscription, automatically acquiring traffic.
5
Multi functional app to find duplicates, empty folders, similar images etc. (翻译：多功能应用程序可查找重复项、空文件夹、相似图像等。)
6
Xray panel supporting multi-protocol multi-user expire day & traffic & ip limit (Vmess & Vless & Trojan & ShadowSocks & Wireguard) (翻译：Xray面板支持多协议多用户到期日&流量&IP限制（Vmess & Vless & Trojan & ShadowSocks & Wireguard)
7
The Free Software Media System (翻译：Jellyfin 是一个免费软件媒体系统，可让您控制管理和流式传输您的媒体。它是专有 Emby 和 Plex 的替代方案，通过多个应用程序从专用服务器向最终用户设备提供媒体。)
8
lightweight, standalone C++ inference engine for Google's Gemma models. (翻译：适用于 Google Gemma 模型的轻量级独立 C++ 推理引擎。)
9
📚 Freely available programming books (翻译：📚 免费提供的编程书籍)
10
A collective list of free APIs (翻译：免费 API 的集合列表)
11
1️⃣🐝🏎️ The One Billion Row Challenge -- A fun exploration of how quickly 1B rows from a text file can be aggregated with Java (翻译：十亿行挑战 —— 使用 Java 对文本文件中的 10 亿行数据进行聚合的有趣探索)
12
🎓 Path to a free self-taught education in Computer Science! (翻译：🎓计算机科学免费自学教程！)
13
Curso para aprender el lenguaje de programación Python desde cero y para principiantes. 75 clases, 37 horas en vídeo, código, proyectos y grupo de chat. Fundamentos, frontend, backend, testing, IA... (翻译：从零开始学习 Python 编程语言的课程，适合初学者)
14
This repository contains System Design resources which are useful while preparing for interviews and learning Distributed Systems (翻译：该存储库包含系统设计资源，在准备面试和学习分布式系统时非常有用)
15
Mamba is a new state space model architecture showing promising performance on information-dense data such as language modeling, where previous subquadratic models fall short of Transformers. It is based on the line of progress on structured state space models, with an efficient hardware-aware design and implementation in the spirit of FlashAttention. (翻译：Mamba 是一种新的状态空间模型架构，在信息密集型数据（例如语言建模）上显示出良好的性能，而之前的二次模型在 Transformers 方面存在不足。它基于结构化状态空间模型的进展，并本着FlashAttention的精神进行高效的硬件感知设计和实现。)