Display downloadButton() based on certain condtions in a shiny adashboard - r

Question

I have the shiny dashboard below in which if I give a name except of the default consent.name,then the password makis and press the Get started actionbutton 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.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(knitr)
mytitle <- paste0("Life, Death & Statins")
dbHeader <- dashboardHeaderPlus(
titleWidth = "0px",
tags$li(a(
div(style = "margin-left:-15px;margin-bottom:-83px;margin-top:-15px;padding: 0px 1190px 0px 0px ; width: 290px;",
img(src = 'download.png', height = "125px",width="232px")),
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"))
),
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(
column(5,),
column(6,
fluidRow(column(3,textInput("name", label = ("Name"), value = "consent.name"))),
fluidRow(
column(5,),
column(6,passwordInput("pwd", "Enter the Database browser password")
)),
actionButton("button", "Get started",style='padding:4px; font-size:140%'),
fluidRow(
column(3,
downloadButton("report", "Generate report",style='padding:4px; font-size:180%')
),
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$button,{
if (input$name=="consent.name"){
return(NULL)
}
else{
if(input$pwd=="makis"){
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())
)
}
)
}
else{
return(NULL)
}
}
})
}
)
)

Answer 1

Using the renderXXX functions inside observers is not recommended.
Here is a way:
library(shiny)
library(markdown)
library(rmarkdown)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
passwordInput("pwd", "Password"),
conditionalPanel(
condition = "output.passwordOK",
actionButton("button", "Generate report"),
),
conditionalPanel(
condition = "output.reportDone",
downloadButton("dwnld", "Download report")
)
),
mainPanel(
uiOutput("preview")
)
)
)
server <- function(input, output, session){
# indicator report has been generated
reportDone <- reactiveVal(FALSE)
output[["reportDone"]] <- reactive({
reportDone()
})
outputOptions(output, "reportDone", suspendWhenHidden = FALSE)
# indicator password is right
passwordOK <- eventReactive(input[["pwd"]], {
input[["pwd"]] == "darwin"
})
output[["passwordOK"]] <- reactive({
passwordOK()
})
outputOptions(output, "passwordOK", suspendWhenHidden = FALSE)
# generate report preview on button click
HTMLreport <- eventReactive(input[["button"]], {
req(passwordOK())
reportDone(TRUE)
HTML(markdownToHTML("www/ex.Rmd", output = NULL))
})
output[["preview"]] <- renderUI({
HTMLreport()
})
# download handler
output[["dwnld"]] <- downloadHandler(
filename = "report.html",
content = function(file){
render("www/ex.Rmd", output_file = file)
}
)
}
shinyApp(ui, server)