Thank you for posting! Here is an outline of an effective post:
Issue
The following is an exam that I have created in hopes of producing a certificate at the end, that users can download if they receive a passing score of 80% or higher. The test has been published using shinyapp io. The code produces a certificate in my files tab but I need a certificate that can be downloaded from the browser. An example of what I am trying to produce can be found here: Using downloadHandler and R Studio 'Export as pdf' (cairo_pdf) - #5 by marsnone - shiny - Posit Community
Posted by jcblum (second to last post) if you run jcblum’s code it produces a PDF that can be downloaded from the browser. No error is produced by my code itself but either a pop-up or the browser download section says “downloadCertificate.htm File wasn’t available on site” Any insight on this issue will be appreciated.
Things I’ve tried:
In the downhandler function I’ve tried plot() and dev.off, by recoding the creation function. I’ve moved downhandler inside the observe event which produces a different type of error. I have even tried just having an already generated PDF available to download and that does not work. Which makes me believe one of two things: I have coded downhandler function incorrectly or that there is a comma or unmatched parathesis that I’ve missed.
** R code **
# Load libraries
library(shiny)
library(shinythemes)
library(dplyr)
library(stringr)
library(shinyjs)
library(readr)
# TEST DATA
Knowledge <- 1
Comprehension <- 2
total_points <- 3
# Produces file but "File is not available on site"
create_certificate <-function(userFirstName,userLastName,final_score){
template <-readr::read_file("certificate_template_pdf.Rmd")
user_certificate <-template %>%
str_replace("<<FIRSTNAME>>", paste0(userFirstName)) %>%
str_replace("<<LASTNAME>>", paste(userLastName))
# str_replace("<<SCORE>>", paste(final_score))
out_filename <-paste(userLastName,userFirstName,"Certificate",sep="_")
out_filename <-paste0(out_filename,'.pdf')
write_file(user_certificate, "tmp.Rmd")
user_pdf<-rmarkdown::render("tmp.Rmd", output_file = out_filename)
file.remove("tmp.Rmd")
}
############## Application ########################
# UI
ui <- fluidPage(theme = shinytheme("cerulean"),
titlePanel("Color Exam"),
shinyjs::useShinyjs(),
mainPanel(width = "100%",
h5(htmlOutput("introduction")),
tags$head(tags$style("#introduction{color: black;}")),
uiOutput("name_fields"),
# h4("Question 1"),
# h5("Level: Knowledge"),
radioButtons("question_one", "What color is grass?",
choices = c("green",
"yellow",
"blue",
"red"),
selected = character(0),
width = "100%"),
textOutput("question_one_fb"),
# h4("Question 2"),
# h5("Level: Comprehension"),
radioButtons("question_two", "Can apples be another color other than red?",
choices = c("True", "False"),
selected = character(0),
width = "100%"),
textOutput("question_two_fb"),
actionButton("submit", "Submit"),
textOutput("score"),
textOutput("Score_Eval_msg"),
shinyjs::hidden(downloadButton("downloadCertificate", "Download Certificate"))
))
############
## Server ##
############
server <- function(input, output, session) {
output$introduction <- renderUI({
HTML("The following is a color exam of common objects.
<p>The questions will be scored as follows:
<p>level 1 = 1 point<br>level 2 = 2 points<br>level 3 = 3 points
<p>Click <strong>Submit</strong> when you complete the exam.")
})
output$name_fields <- renderUI({
fluidRow(
column(6, textInput("first_name", "First Name:")),
column(6, textInput("last_name", "Last Name:"))
)
})
user_lastName <- reactiveVal()
user_firstName <- reactiveVal()
observeEvent(input$first_name, {
user_firstName(input$first_name)
})
observeEvent(input$last_name, {
user_lastName(input$last_name)
})
correct_question_one_answer <-"green"
correct_question_two_answer <-"True"
user_question_one_answer <- reactiveVal()
user_question_two_answer <- reactiveVal()
observeEvent(input$question_one, {
user_question_one_answer(input$question_one)
})
observeEvent(input$question_two, {
user_question_two_answer(input$question_two)
})
observeEvent(input$submit, {
question_one_answer <- user_question_one_answer()
question_two_answer <- user_question_two_answer()
if (is.null(question_one_answer)){
question_one_feedback <-"Incorrect."
} else if (question_one_answer!=correct_question_one_answer){
question_one_feedback <-"Incorrect."
} else {
question_one_feedback <-"Correct!"
}
if (is.null(question_two_answer)){
question_two_feedback <- "Incorrect."
} else if(question_two_answer !=correct_question_two_answer) {
question_two_feedback <- "Incorrect."
} else {
question_two_feedback <-"Correct!"
}
output$question_one_fb <- renderText({
question_one_feedback
})
output$question_two_fb <- renderText({
question_two_feedback
})
total_score <- ifelse(question_one_feedback == "Correct!", Knowledge, 0) +
ifelse(question_two_feedback == "Correct!", Comprehension, 0)
#Scoring
scores <- reactiveValues(total = 0)
scores$total <- total_score
# Display total score
output$score <- renderText({
paste("Score: ", scores$total, "/",total_points)
})
#Score Evaluation
final_score <-as.numeric(scores$total/total_points)
# Score_Eval_msg <-ifelse(final_score >=0.80,"Congratulations! Please follow the instructions below to receive your certificate.","A passing score of 80% or higher is required. Please try again.")
output$Score_Eval_msg <-renderText({Score_Eval_msg})
if (final_score >= 0.80) {
Score_Eval_msg <- paste0("Congratulations! Click the download button to retrieve your certificate.")
shinyjs::show("downloadCertificate")
} else {
Score_Eval_msg <- paste0("A passing score of 80% or higher is required. Please try again.")
shinyjs::hide("downloadCertificate")
}
output$Score_Eval_msg <- renderText({
Score_Eval_msg
})
}) # End of observeEvent input$submit
#Error Produced: File wasn't available on site
#original code
output$downloadCertificate <- downloadHandler(filename=function(){paste(user_lastName(), user_firstName(), "Certificate.pdf", sep = "_")},
content = function(file) {
# create_certificate
create_certificate(user_firstName(),user_lastName())
} #end of content
# contentType = "https://epitutoring.shinyapps.io/multi_choice/pdf"
)
}
shinyApp(ui, server)
rmd
---
title: "Certificate"
output: pdf_document
classoption: landscape
header-includes:
- \pagenumbering{gobble}
---
\begin{center}
<!-- \includegraphics[height=4cm]{fig1.png} -->
\hfill
<!-- \includegraphics[height=4cm]{fig2.jpg} \\ -->
\bigskip
\Huge\bf Certificate of Accomplishment \par
\bigskip
\Huge <<FIRSTNAME>> <<LASTNAME>> \par
\bigskip
\Large has successfully completed the exam over \par
{\it Colors \par}
\Large with a score of <<SCORE>>\% \par
\bigskip
\Huge Congratulations!\par
\end{center}
