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())
)
}
)
})
}
)
)
and how this is connected with the downloadhandler()?
I edited based on your method but I do not think that the button works now.
Please modify the condition in the statement
if (input$pwd=="makis" & input$button>0 ) {...to the condition under which you would like the download Button to be displayed.but why when I press the download button it does not download anymore, regardless of when the button is displayed?
Please try the updated code.