我下面有一个 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())
)
}
)
})
}
)
)
以及如何与downloadhandler（）连接？
我根据您的方法进行了编辑，但我认为该按钮现在无法正常工作。
请将该语句
if (input$pwd=="makis" & input$button>0 ) {...中的条件修改为希望显示下载按钮的条件。但是为什么当我按下下载按钮时，无论何时显示该按钮，它都不再下载？
请尝试更新的代码。