问题
I have the shiny dashboard below in which if I give a name except of the default consent.name, then press Continue and will be moved in the tabItem Password in which I give the password makis and press the Get started actionbutton in either Welcome or Run Project tab an rmd output is generated. Then the user can press 'Generate report' in order to download this as pdf. Basically what I want to do is to display the 'Generate report' downloadButton() only when the report is created and displayed in the body because otherwise it has no meaning and is confusing. I tried to applied the observeEvent() method which I used for the report creation as well but it does not work and the downloadButton() is always there.
the 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)
and the app
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())
)
}
)
})
}
)
)
回答1:
One way to do it is to use renderUI on the server side to display the downloadButton. Then you can use the condition under which you want to display the Generate Report button. You need to replace downloadButton with uiOutput("downloadbtn") in the ui. Try this in the server.
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)
}
}
})
来源：https://stackoverflow.com/questions/65044981/display-download-button-in-a-tab-based-on-actions-in-other-tabs-of-a-shiny-dashb