├── .Rbuildignore ├── assets └── hex-riddlr.kra ├── inst ├── www │ ├── hex-riddlr.png │ └── riddlr.css └── example │ ├── shiny │ ├── question_catalog │ │ ├── install.R │ │ ├── welcome.md │ │ └── app.R │ └── single_question │ │ └── app.R │ └── questions │ ├── q2.riddlr.Rmd │ ├── q5.riddlr.Rmd │ ├── q1.riddlr.Rmd │ ├── q4.riddlr.Rmd │ └── q3.riddlr.Rmd ├── man ├── parse_safe.Rd ├── success_response.Rd ├── riddle_response_html.Rd ├── parse_error_response.Rd ├── eval_with_timeout.Rd ├── timeout_response.Rd ├── error_response.Rd ├── update_test_progress_html.Rd ├── with_env_cleanup.Rd ├── timeout_error_cpu.Rd ├── incorrect_solution_response.Rd ├── riddlr_base_env.Rd ├── is_timeout_error.Rd ├── grace_timeouts_response.Rd ├── opts.Rd └── grade_riddle.Rd ├── R ├── shiny_riddlr_resource.R ├── shiny_actionButtonPrimary.R ├── riddlr_env.R ├── opts.R ├── riddlr_result.R ├── utils.R ├── run_riddle.R ├── shiny_riddlr_module.R ├── parse_riddlr_rmd.R └── grade_riddle.R ├── riddlr.Rproj ├── DESCRIPTION ├── .gitignore ├── LICENSE ├── NAMESPACE └── README.md /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^assets 4 | -------------------------------------------------------------------------------- /assets/hex-riddlr.kra: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dgkf/riddlr/HEAD/assets/hex-riddlr.kra -------------------------------------------------------------------------------- /inst/www/hex-riddlr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dgkf/riddlr/HEAD/inst/www/hex-riddlr.png -------------------------------------------------------------------------------- /man/parse_safe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{parse_safe} 4 | \alias{parse_safe} 5 | \title{Parsing with error handling} 6 | \usage{ 7 | parse_safe(...) 8 | } 9 | \description{ 10 | Parsing with error handling 11 | } 12 | -------------------------------------------------------------------------------- /man/success_response.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{success_response} 4 | \alias{success_response} 5 | \title{Response for successful solution} 6 | \usage{ 7 | success_response(hash = runif(1)) 8 | } 9 | \description{ 10 | Response for successful solution 11 | } 12 | -------------------------------------------------------------------------------- /man/riddle_response_html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{riddle_response_html} 4 | \alias{riddle_response_html} 5 | \title{Format a riddlr response as HTML output} 6 | \usage{ 7 | riddle_response_html(x) 8 | } 9 | \description{ 10 | Format a riddlr response as HTML output 11 | } 12 | -------------------------------------------------------------------------------- /man/parse_error_response.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{parse_error_response} 4 | \alias{parse_error_response} 5 | \title{Response for a solutions that produce errors} 6 | \usage{ 7 | parse_error_response(x, ...) 8 | } 9 | \description{ 10 | Response for a solutions that produce errors 11 | } 12 | -------------------------------------------------------------------------------- /man/eval_with_timeout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{eval_with_timeout} 4 | \alias{eval_with_timeout} 5 | \title{Evaluate and memoise solution execution} 6 | \usage{ 7 | eval_with_timeout(x, timeout = Inf, envir = parent.frame()) 8 | } 9 | \description{ 10 | Evaluate and memoise solution execution 11 | } 12 | -------------------------------------------------------------------------------- /man/timeout_response.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{timeout_response} 4 | \alias{timeout_response} 5 | \title{Response for a solution that times out} 6 | \usage{ 7 | timeout_response(x, solution_output, input_env, test_i, test_n) 8 | } 9 | \description{ 10 | Response for a solution that times out 11 | } 12 | -------------------------------------------------------------------------------- /man/error_response.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{error_response} 4 | \alias{error_response} 5 | \title{Response for a solutions that produce errors} 6 | \usage{ 7 | error_response(x, solution_output, input_env, test_i, test_n) 8 | } 9 | \description{ 10 | Response for a solutions that produce errors 11 | } 12 | -------------------------------------------------------------------------------- /R/shiny_riddlr_resource.R: -------------------------------------------------------------------------------- 1 | #' 2 | #' @importFrom shiny addResourcePath singleton tags 3 | #' @export 4 | #' 5 | riddlr_css <- function() { 6 | shiny::addResourcePath("riddlr", system.file("www", package = "riddlr")) 7 | shiny::singleton(shiny::tags$head(shiny::tags$link( 8 | id = "riddlr-css", 9 | rel = "stylesheet", 10 | type = "text/css", 11 | href = "riddlr/riddlr.css" 12 | ))) 13 | } 14 | -------------------------------------------------------------------------------- /man/update_test_progress_html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{update_test_progress_html} 4 | \alias{update_test_progress_html} 5 | \title{Format test results as html for updating progress text} 6 | \usage{ 7 | update_test_progress_html(test_results, reactive_output) 8 | } 9 | \description{ 10 | Format test results as html for updating progress text 11 | } 12 | -------------------------------------------------------------------------------- /man/with_env_cleanup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/riddlr_env.R 3 | \name{with_env_cleanup} 4 | \alias{with_env_cleanup} 5 | \title{Helper to ensure that any library calls get undone by the end of evaluation} 6 | \usage{ 7 | with_env_cleanup(expr, envir = parent.frame()) 8 | } 9 | \description{ 10 | Helper to ensure that any library calls get undone by the end of evaluation 11 | } 12 | -------------------------------------------------------------------------------- /R/shiny_actionButtonPrimary.R: -------------------------------------------------------------------------------- 1 | modifyCssClasses <- function(x, ...) { 2 | dots <- as.list(match.call())[-1] 3 | dots <- gsub("\\s+", "", as.character(dots[names(dots) == ""])) 4 | 5 | classes <- strsplit(x$attribs$class, " ")[[1]] 6 | classes <- setdiff(classes, gsub("^-", "", dots[grepl("^-", dots)])) 7 | classes <- sort(c(classes, dots[grepl("^[^-]", dots)])) 8 | 9 | x$attribs$class <- paste(classes, collapse = " ") 10 | x 11 | } 12 | -------------------------------------------------------------------------------- /man/timeout_error_cpu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \docType{data} 4 | \name{timeout_error_cpu} 5 | \alias{timeout_error_cpu} 6 | \title{compute a timeout error from setTimeLimit} 7 | \format{ 8 | An object of class \code{NULL} of length 0. 9 | } 10 | \usage{ 11 | timeout_error_cpu 12 | } 13 | \description{ 14 | compute a timeout error from setTimeLimit 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/incorrect_solution_response.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{incorrect_solution_response} 4 | \alias{incorrect_solution_response} 5 | \title{Response for an incorrect solution} 6 | \usage{ 7 | incorrect_solution_response( 8 | user_output, 9 | solution_output, 10 | input_env, 11 | test_i, 12 | test_n, 13 | err 14 | ) 15 | } 16 | \description{ 17 | Response for an incorrect solution 18 | } 19 | -------------------------------------------------------------------------------- /man/riddlr_base_env.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/riddlr_env.R 3 | \docType{data} 4 | \name{riddlr_base_env} 5 | \alias{riddlr_base_env} 6 | \title{Build a base environment for solutions to be evaluated within} 7 | \format{ 8 | An object of class \code{environment} of length 0. 9 | } 10 | \usage{ 11 | riddlr_base_env 12 | } 13 | \description{ 14 | Build a base environment for solutions to be evaluated within 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /riddlr.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/is_timeout_error.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{is_timeout_error} 4 | \alias{is_timeout_error} 5 | \title{Compare an error against a timeout error from setTimeLimit} 6 | \usage{ 7 | is_timeout_error(e) 8 | } 9 | \arguments{ 10 | \item{e}{an error to compare} 11 | } 12 | \value{ 13 | a logical indicating whether e is a setTimeLimit timeout error 14 | } 15 | \description{ 16 | Compare an error against a timeout error from setTimeLimit 17 | } 18 | -------------------------------------------------------------------------------- /man/grace_timeouts_response.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{grace_timeouts_response} 4 | \alias{grace_timeouts_response} 5 | \title{Response for a solution that times out only a grace period} 6 | \usage{ 7 | grace_timeouts_response( 8 | user_output, 9 | solution_output, 10 | input_env, 11 | test_i, 12 | test_n, 13 | time_frac 14 | ) 15 | } 16 | \description{ 17 | Response for a solution that times out only a grace period 18 | } 19 | -------------------------------------------------------------------------------- /inst/www/riddlr.css: -------------------------------------------------------------------------------- 1 | .riddlr-run-btns { 2 | float: right; 3 | } 4 | 5 | /* 6 | #riddlr_submit { 7 | background: rgb(24,188,156); 8 | border: 0 solid; 9 | } 10 | */ 11 | 12 | .alert { 13 | border-radius: 0; 14 | } 15 | 16 | .riddlr-alert code { 17 | background: none; 18 | } 19 | 20 | .riddlr-alert pre { 21 | /* color: white; */ 22 | border: 0 solid; 23 | background-color: #555; 24 | background-color: rgba(255, 255, 255, 0.1); 25 | } 26 | 27 | pre { 28 | border: #222; 29 | border: 1px solid rgba(0, 0, 0, 0.1); 30 | border-radius: 0; 31 | } 32 | -------------------------------------------------------------------------------- /inst/example/shiny/question_catalog/install.R: -------------------------------------------------------------------------------- 1 | if_unavailable <- function(pkg, expr, envir = parent.frame()) 2 | if (!pkg %in% installed.packages()) invisible(eval(expr, envir = envir)) 3 | 4 | if_unavailable("devtools", install.packages("devtools")) 5 | if_unavailable("riddlr", devtools::install_github("dgkf/riddlr")) 6 | if_unavailable("shinythemes", install.packages("shinythemes")) 7 | if_unavailable("shinydashboard", install.packages("shinydashboard")) 8 | if_unavailable("shinycssloaders", install.packages("shinycssloaders")) 9 | if_unavailable("dplyr", install.packages("dplyr")) 10 | if_unavailable("tidyr", install.packages("tidyr")) 11 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: riddlr 3 | Title: A package for building interactive programming challenges 4 | Version: 0.0.1 5 | Authors@R: 6 | person(given = "Doug", 7 | family = "Kelkhoff", 8 | role = c("aut", "cre"), 9 | email = "doug.kelkhoff@gmail.com") 10 | Description: A package for building interactive programming 11 | challenges 12 | License: MIT 13 | BugReports: https://github.com/dgkf/riddlr 14 | Imports: 15 | utils, 16 | shiny, 17 | shinyAce (>= 0.4), 18 | rmarkdown, 19 | markdown, 20 | memoise, 21 | yaml 22 | VignetteBuilder: 23 | knitr 24 | Encoding: UTF-8 25 | LazyData: true 26 | RoxygenNote: 7.1.1 27 | -------------------------------------------------------------------------------- /R/riddlr_env.R: -------------------------------------------------------------------------------- 1 | #' Build a base environment for solutions to be evaluated within 2 | riddlr_base_env <- Reduce(function(l, r) { parent.env(l) <- r; l }, 3 | lapply(c("methods", "datasets", "utils", "tools", "stats"), getNamespace), 4 | init = new.env(parent = getNamespace("base"))) 5 | 6 | 7 | 8 | #' Helper to ensure that any library calls get undone by the end of evaluation 9 | with_env_cleanup <- function(expr, envir = parent.frame()) { 10 | start_env_pos <- length(search()) 11 | on.exit({ 12 | while (length(search()) > start_env_pos) 13 | detach(attr(pos.to.env(2L), "name"), 14 | unload = TRUE, 15 | character.only = TRUE) 16 | }) 17 | eval(expr, envir = envir) 18 | } 19 | -------------------------------------------------------------------------------- /inst/example/shiny/single_question/app.R: -------------------------------------------------------------------------------- 1 | library(riddlr) 2 | library(shiny) 3 | library(shinyAce) 4 | library(markdown) 5 | 6 | # ensure interactive console width won't affect output 7 | options(width = 80) 8 | 9 | r <- parse_riddlr_rmd(system.file( 10 | "example", 11 | "questions", 12 | "q3.riddlr.Rmd", 13 | package = "riddlr")) 14 | 15 | ui <- fluidPage( 16 | riddle_ui("riddle", 17 | question_ui = r$prompt, 18 | metadata = r$metadata)) 19 | 20 | server <- function(input, output, session) { 21 | observe(callModule(riddle, "riddle", 22 | solution = r$grader$solution, 23 | quoted = TRUE, 24 | test_inputs = r$grader$test_inputs, 25 | test_timeouts = r$grader$test_timeouts)) 26 | } 27 | 28 | shinyApp(ui, server) 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | -------------------------------------------------------------------------------- /man/opts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/opts.R 3 | \docType{data} 4 | \name{opts} 5 | \alias{opts} 6 | \title{Getters and setters for riddlr options} 7 | \format{ 8 | An object of class \code{list} of length 2. 9 | } 10 | \usage{ 11 | opts 12 | } 13 | \description{ 14 | \describe{ 15 | \item{onSubmit}{ 16 | Expects a function expecting arguments \code{code}, \code{duration} and 17 | \code{response}. This function is called after a question solution is 18 | submitted and graded and can be used as a callback for additional 19 | functionality or logging. 20 | } 21 | } 22 | } 23 | \examples{ 24 | opts$set(onSubmit = function(code, duration, response) message("submitted")) 25 | 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /R/opts.R: -------------------------------------------------------------------------------- 1 | #' Getters and setters for riddlr options 2 | #' 3 | #' \describe{ 4 | #' \item{onSubmit}{ 5 | #' Expects a function expecting arguments \code{code}, \code{duration} and 6 | #' \code{response}. This function is called after a question solution is 7 | #' submitted and graded and can be used as a callback for additional 8 | #' functionality or logging. 9 | #' } 10 | #' } 11 | #' 12 | #' @importFrom utils modifyList 13 | #' @export 14 | #' 15 | #' @examples 16 | #' opts$set(onSubmit = function(code, duration, response) message("submitted")) 17 | #' 18 | opts <- list( 19 | get = function(name) riddlr:::.opts[[name]], 20 | set = function(...) { 21 | assignInMyNamespace(".opts", utils::modifyList(riddlr:::.opts, list(...))) 22 | }) 23 | 24 | 25 | 26 | .opts <- list() 27 | .opts$onSubmit <- function(code, duration, response) { } 28 | -------------------------------------------------------------------------------- /man/grade_riddle.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/grade_riddle.R 3 | \name{grade_riddle} 4 | \alias{grade_riddle} 5 | \title{function for generating an exercise checker for a puzzlr challenge} 6 | \usage{ 7 | grade_riddle( 8 | user_code, 9 | solution, 10 | test_inputs, 11 | test_timeouts = Inf, 12 | grace_timeouts = test_timeouts * 5, 13 | test_details = rep(list(NULL), length(test_inputs)), 14 | quoted = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{solution}{solution code} 19 | 20 | \item{envs}{environments in which solution should be evaluated. these should 21 | contain the necessary input variables for the challenge.} 22 | } 23 | \value{ 24 | A shiny ui element displaying output from grading the question 25 | solution. 26 | } 27 | \description{ 28 | function for generating an exercise checker for a puzzlr challenge 29 | } 30 | -------------------------------------------------------------------------------- /R/riddlr_result.R: -------------------------------------------------------------------------------- 1 | riddlr_result <- function(result, expr = NULL, duration = NULL, 2 | console = NULL, warnings = NULL) { 3 | 4 | r_class <- c("riddlr_result", class(result)) 5 | if (!is.null(warnings)) r_class <- c(r_class, "warning") 6 | 7 | structure(result, 8 | expr = expr, 9 | warnings = warnings, 10 | duration = duration, 11 | console = console, 12 | class = r_class) 13 | } 14 | 15 | 16 | 17 | unclass_riddlr_result <- function(x) { 18 | x <- unclass(x) 19 | attributes(x) <- NULL 20 | x 21 | } 22 | 23 | 24 | 25 | #' @export 26 | print.riddlr_result <- function(x, ...) { 27 | print(unclass_riddlr_result(x), ...) 28 | } 29 | 30 | 31 | 32 | format.riddlr_result <- function(x, ...) { 33 | format(unclass_riddlr_result(x), ...) 34 | } 35 | 36 | 37 | 38 | Ops.riddlr_result <- function(e1, e2) { 39 | if (.Generic == "==") { 40 | e1 <- unclass_riddlr_result(e1) 41 | e2 <- unclass_riddlr_result(e2) 42 | return(identical(e1, e2)) 43 | } else if (.Generic == "!=") { 44 | return(!(e1 == e2)) 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 dgkf 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,riddlr_result) 4 | export(bootstrapify) 5 | export(error_response) 6 | export(grace_timeouts_response) 7 | export(grade_riddle) 8 | export(is_timeout_error) 9 | export(modifyCssClasses) 10 | export(opts) 11 | export(parse_error_response) 12 | export(parse_riddlr_dir_headers) 13 | export(parse_riddlr_rmd) 14 | export(riddle) 15 | export(riddle_response_html) 16 | export(riddle_ui) 17 | export(riddlr_css) 18 | export(run_riddle) 19 | export(success_response) 20 | export(timeout_response) 21 | importFrom(markdown,markdownToHTML) 22 | importFrom(memoise,memoise) 23 | importFrom(rmarkdown,html_fragment) 24 | importFrom(rmarkdown,render) 25 | importFrom(rmarkdown,yaml_front_matter) 26 | importFrom(shiny,HTML) 27 | importFrom(shiny,addResourcePath) 28 | importFrom(shiny,div) 29 | importFrom(shiny,h2) 30 | importFrom(shiny,is.reactive) 31 | importFrom(shiny,observeEvent) 32 | importFrom(shiny,reactiveVal) 33 | importFrom(shiny,renderUI) 34 | importFrom(shiny,setProgress) 35 | importFrom(shiny,singleton) 36 | importFrom(shiny,tagList) 37 | importFrom(shiny,tags) 38 | importFrom(shiny,withProgress) 39 | importFrom(shinyAce,aceAnnotate) 40 | importFrom(shinyAce,aceAutocomplete) 41 | importFrom(shinyAce,aceEditor) 42 | importFrom(shinyAce,aceTooltip) 43 | importFrom(utils,modifyList) 44 | -------------------------------------------------------------------------------- /inst/example/questions/q2.riddlr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Dealing with Filenames" 3 | # author: "Your Name" # Optionally take some credit for submitting a question! 4 | difficulty: 0.1 5 | tags: 6 | - filesystem 7 | - tools 8 | details: > 9 | Handle filepaths to get the name of a file without the trailing extension 10 | --- 11 | 12 | 13 | Given a character vector of filepaths (such as `/home/id/project/analysis.R`), 14 | return the name of the filename without the file extension. 15 | 16 | For example, if given the vector 17 | 18 | ```{} 19 | filepaths <- c("/home/id/project/analysis.R", "/home/id/project/report.Rmd") 20 | ``` 21 | 22 | The answer would be 23 | 24 | ```{} 25 | c("analysis", "report") 26 | ``` 27 | 28 | 29 | 30 | ```{r grader} 31 | library(tools) 32 | 33 | test_inputs <- list( 34 | list(filepaths = c( 35 | "/home/id/project/analysis.R", 36 | "/home/id/project/report.Rmd")), 37 | list(filepaths = c( 38 | "/home/id/project/analysis.R", 39 | "/home/id/project/analysis.knit.Rmd", 40 | "/home/id/project/.Rprofile"))) 41 | 42 | list( 43 | test_inputs = test_inputs, 44 | test_timeouts = 0.1, 45 | solution = quote(tools::file_path_sans_ext(basename(filepaths))), 46 | quoted = TRUE) 47 | ``` 48 | 49 | ```{r starter, eval = FALSE} 50 | # already in environment: 51 | # tools package is available to use 52 | # filepaths (a character vector of filepaths, 1 <= length <= 10) 53 | 54 | library(tools) 55 | 56 | print(filepaths) 57 | ``` 58 | -------------------------------------------------------------------------------- /inst/example/questions/q5.riddlr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Finding String Matches" 3 | # author: "Your Name" # Optionally take some credit for submitting a question! 4 | difficulty: 0.2 5 | tags: 6 | - strings 7 | details: > 8 | Find matches of an entire word within a vector of strings 9 | --- 10 | 11 | 12 | 13 | You're given a vector of strings and a keyword. Return a vector containing only the strings that contained the keyword as a whole word (not as part of a word). 14 | 15 | For example, with the following input 16 | 17 | ```{} 18 | strings <- c("podcast","castle","cast off","plaster cast") 19 | keyword <- "cast" 20 | ``` 21 | 22 | The answer would be 23 | 24 | ```{} 25 | c("cast off", "plaster cast") 26 | ``` 27 | 28 | 29 | 30 | ```{r grader} 31 | # 32 | # a code chunk named 'grader' should produce a list of arguments to use with the 33 | # grade_riddle function. 34 | # 35 | 36 | list( 37 | test_inputs = list( 38 | list( 39 | strings = c("code red","decode","coding is fun"), 40 | keyword = "code" 41 | ), 42 | list( 43 | strings = c("sawyer","chain saw","I saw you yesterday."), 44 | keyword = "saw" 45 | ), 46 | list( 47 | strings = c("robotics","build a robot","robots are taking over"), 48 | keyword = "robot" 49 | ) 50 | ), 51 | test_timeouts = 0.1, 52 | solution = quote({ 53 | strings[grepl(paste0("\\b",keyword,"\\b"),strings, ignore.case = TRUE)] 54 | }), 55 | quoted = TRUE) 56 | ``` 57 | 58 | ```{r starter, eval = FALSE} 59 | # already in environment: 60 | # strings (a character vector of strings, 1 < length <= 10) 61 | # keyword (a string) 62 | 63 | print(strings) 64 | print(keyword) 65 | ``` 66 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | `%||%` <- function(lhs, rhs) if (is.null(lhs) || !length(lhs)) rhs else lhs 2 | 3 | 4 | 5 | #' Compare an error against a timeout error from setTimeLimit 6 | #' 7 | #' @param e an error to compare 8 | #' 9 | #' @return a logical indicating whether e is a setTimeLimit timeout error 10 | #' @export 11 | is_timeout_error <- function(e) { 12 | if (!"error" %in% class(e)) return(FALSE) 13 | (identical(attributes(e), attributes(timeout_error_cpu)) || 14 | identical(attributes(e), attributes(timeout_error_elapsed))) && 15 | (identical(e$message, timeout_error_cpu$message) || 16 | identical(e$message, timeout_error_elapsed$message)) 17 | } 18 | 19 | #' compute a timeout error from setTimeLimit 20 | timeout_error_cpu <- tryCatch({ 21 | setTimeLimit(cpu = 0.0001, elapsed = Inf, transient = TRUE) 22 | Sys.sleep(0.001) 23 | }, error = function(e) e) 24 | 25 | timeout_error_elapsed <- tryCatch({ 26 | setTimeLimit(cpu = Inf, elapsed = 0.0001, transient = TRUE) 27 | Sys.sleep(0.001) 28 | }, error = function(e) e) 29 | 30 | 31 | 32 | is_error <- function(x) return(inherits(x, "error")) 33 | is_warning <- function(x) return(inherits(x, "warning")) 34 | 35 | 36 | 37 | #' @export 38 | modifyCssClasses <- function(x, ...) { 39 | dots <- as.list(match.call())[-1] 40 | dots <- gsub("\\s+", "", as.character(dots[names(dots) == ""])) 41 | 42 | classes <- strsplit(x$attribs$class, " ")[[1]] 43 | classes <- setdiff(classes, gsub("^-", "", dots[grepl("^-", dots)])) 44 | classes <- sort(c(classes, dots[grepl("^[^-]", dots)])) 45 | 46 | x$attribs$class <- paste(classes, collapse = " ") 47 | x 48 | } 49 | 50 | 51 | 52 | #' @export 53 | bootstrapify <- function(x) { 54 | gsub("", "", 55 | gsub("", "
2 | 3 | A package for making coding challenges, largely inspired by the 4 | [`learnr`](https://github.com/rstudio/learnr) package. 5 | 6 | ## Installation 7 | 8 | Install the package off of GitHub via 9 | 10 | ```r 11 | devtools::install_github("dgkf/riddlr") 12 | ``` 13 | 14 | ## Quick Start 15 | 16 | Try out some examples: 17 | 18 | ### Building a single question shiny app 19 | 20 | ```r 21 | library(shiny) 22 | 23 | app_file <- system.file("example", "shiny", "single_question", "app.R", package = "riddlr") 24 | shinyAppFile(app_file) 25 | ``` 26 | 27 | ### Rendering a searchable question catalog shiny app 28 | 29 | ```r 30 | library(shiny) 31 | 32 | app_file <- system.file("example", "shiny", "question_catalog", "app.R", package = "riddlr") 33 | shinyAppFile(app_file) 34 | ``` 35 | 36 | ## Community Shout-outs 37 | 38 | ### `learnr` 39 | 40 | A lot of this package is inspired by `learnr`, with early versions being built 41 | directly into `learnr`'s Rmarkdown framework. The scope is slightly different, 42 | being an evaluation tool rather than a learning tool. From this slight change in 43 | perspective, there were a few features that `learnr` couldn't accommodate. 44 | 45 | - easily testing code against multiple test cases, whereas `learnr` only handles 46 | a single input 47 | - timeout per test case (or timeout with a grace period for feedback) 48 | - hooks for triggering database logs 49 | - easier addition of markdown-formatted help dialogs 50 | 51 | Could this all be contributed back to the `learnr` package? Absolutely, but 52 | ensuring code quality, reusability and consistency within the `learnr` 53 | framework wasn't within scope for the proof-of-concept. 54 | 55 | ### `shinyAce` 56 | 57 | A lot of work was put into giving a comfortable programming interface with 58 | staple features like improved code completion, help-text popups, parsing errors 59 | and warnings noted in the code form gutter. All of these features were first 60 | added internally as part of the proof-of-concept, but were later [contributed 61 | back](https://github.com/trestletech/shinyAce/pull/66) to the `shinyAce` 62 | package. 63 | 64 | A huge thank you goes out to [**@vnijs**](https://github.com/vnijs) and 65 | [**@detule**](https://github.com/detule) for giving great feedback on 66 | such a large body of new features and diligently checking many edge cases 67 | that would have gone unaddressed. 68 | -------------------------------------------------------------------------------- /inst/example/questions/q1.riddlr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Comparing Vectors" 3 | # author: "Your Name" # Optionally take some credit for submitting a question! 4 | difficulty: 0.1 5 | tags: 6 | - vectors 7 | details: > 8 | Filter vectors for mismatched values 9 | instructions: > 10 | This document can be used as a template 'riddle' input. 11 | 12 | There are two meaningfully named code chunks, 'grader' and 'starter'. 13 | - grader is used to produce a argument list which will be provided to 14 | riddlr::grade_riddle. For more details about viable arguments see 15 | ?riddlr::grade_riddle. 16 | - starter is used to prepopulate the code block in the riddle ui. 17 | - everything else is used to populate the challenge instructions. 18 | - you can double check that everything will run by trying to run 19 | `parse_riddlr_rmd('path/to/your.riddlr.Rmd')` 20 | 21 | A good riddle should be prescriptive in scope with little to no room for 22 | interpretation. It's best if an example of a trivial case is provided, and 23 | that the trivial case is also used as your first test case. 24 | --- 25 | 26 | 27 | 28 | You're given two numeric vectors, `a` and `b`. `b` is identical to `a`, except 29 | that two numbers have been swapped. Return a numeric vector of length 2 30 | containing the values of the two swapped numbers in increasing order. 31 | 32 | For example, with the following input 33 | 34 | ```{} 35 | a <- c(1, 1, 2, 3, 5, 8, 13, 21, 34, 55) 36 | b <- c(1, 1, 13, 3, 5, 8, 2, 21, 34, 55) 37 | ``` 38 | 39 | The answer would be 40 | 41 | ```{} 42 | c(2, 13) 43 | ``` 44 | 45 | 46 | 47 | ```{r grader} 48 | # 49 | # a code chunk named 'grader' should produce a list of arguments to use with the 50 | # grade_riddle function. 51 | # 52 | generate_test_input <- function(a) { 53 | swap_indxs <- sample(1:length(a), 2, replace = FALSE) 54 | b <- a 55 | b[swap_indxs] <- b[rev(swap_indxs)] 56 | list(a = a, b = b) 57 | } 58 | 59 | list( 60 | test_inputs = list( 61 | list( 62 | a = c(1, 1, 2, 3, 5, 8, 13, 21, 34, 55), 63 | b = c(1, 1, 13, 3, 5, 8, 2, 21, 34, 55)), 64 | generate_test_input(1:10), 65 | generate_test_input(10:1), 66 | generate_test_input(runif(100, -50, 50))), 67 | test_timeouts = 0.5, 68 | solution = quote(sort(a[a != b])), 69 | quoted = TRUE) 70 | ``` 71 | 72 | ```{r starter, eval = FALSE} 73 | # already in environment: 74 | # a (numeric vector, 1 <= length <= 10,000) 75 | # b (numeric vector, 1 <= length <= 10,000) 76 | 77 | print(a) 78 | print(b) 79 | ``` 80 | -------------------------------------------------------------------------------- /inst/example/questions/q4.riddlr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Renaming dataframe columns" 3 | # author: "Your Name" # Optionally take some credit for submitting a question! 4 | difficulty: 0.1 5 | tags: 6 | - dataframes 7 | details: > 8 | Give a dataframe meaningul column names 9 | editor_options: 10 | chunk_output_type: console 11 | --- 12 | 13 | You're provided with a data frame, `df`, containing important data. However, the column names are generic and provide no clue as to the variable. You have a vector of strings that provide meaningful column names, `helpful_column_names`. Replace the column names of data frame `df` with the vector `helpful_column_names`. 14 | 15 | For example, with the following input 16 | 17 | ```{} 18 | 19 | df = data.frame( 20 | a = c(10, 12, 14), 21 | b = c(2, 6, 8), 22 | c = c(5, 7, 9) 23 | ) 24 | 25 | helpful_column_names = c("width", "length", "height") 26 | 27 | ``` 28 | 29 | The answer would be 30 | 31 | ```{} 32 | 33 | width length height 34 | 1 10 2 5 35 | 2 12 6 7 36 | 3 14 8 9 37 | 38 | ``` 39 | 40 | 41 | 42 | ```{r grader} 43 | # 44 | # a code chunk named 'grader' should produce a list of arguments to use with the 45 | # grade_riddle function. 46 | # 47 | 48 | list( 49 | test_inputs = list( 50 | list( 51 | df = data.frame( 52 | a = c(10, 12, 14), 53 | b = c(2, 6, 8), 54 | c = c(5, 7, 9) 55 | ), 56 | helpful_column_names = c("width", "length", "height") 57 | ), 58 | list( 59 | df = data.frame( 60 | a = c(3, 4), 61 | b = c(5, 6) 62 | ), 63 | helpful_column_names = c("size", "weight") 64 | ), 65 | list( 66 | df = data.frame( 67 | a = seq(1, 5, 1), 68 | b = seq(2, 10, 2), 69 | c = seq(10, 50, 10), 70 | d = seq(1, 5, 1), 71 | e = seq(2, 10, 2) 72 | ), 73 | helpful_column_names = c("size", "weight", "height", "depth", "z-axis") 74 | ) 75 | ), 76 | test_timeouts = 0.1, 77 | solution = quote({ 78 | colnames(df) = helpful_column_names 79 | print(df) 80 | }), 81 | quoted = TRUE) 82 | 83 | 84 | ``` 85 | 86 | ```{r starter, eval = FALSE} 87 | # already in environment: 88 | # df (data frame, n x n dimensions; n integer vector 0 < value <= 5) 89 | # helpful_column_names (a character vector of strings, 1 <= length <= 5) 90 | # 91 | # HINT: Don't forget to use the print(df) command at the end of your script 92 | # to output the data frame for grading. 93 | 94 | 95 | print(df) 96 | 97 | print(helpful_column_names) 98 | 99 | ``` 100 | -------------------------------------------------------------------------------- /inst/example/shiny/question_catalog/welcome.md: -------------------------------------------------------------------------------- 1 | Welcome to [`riddlr`](github.com/dgkf/riddlr), a framework for evaluating R code 2 | against a set of preset solutions. 3 | 4 | > ## Quick Start 5 | > 6 | > Start testing your R skills against some example questions by navigating to the 7 | catalog page. Once you've found one you want to tackle, click the `>_` icon to 8 | launch the riddle. 9 | 10 | --- 11 | 12 | #### Details 13 | 14 | Riddles consist of a question prompt, user code block and a known correct 15 | solution. When a user loads up a riddle, `shiny` will render a question `Rmd` 16 | file as a new page and provide the user with a prepopulated code block to test 17 | their mettle. Code can be run with console output displayed to the user. When 18 | they're satisfied with their solution, they can submit it where their solution 19 | will be evaluated and the output will be compared against the output of the 20 | solution code run against the same test input. 21 | 22 | If a test fails, execution stops and the user gets feedback about the input that 23 | was used, expected result and what their code produced to allow them to iterate 24 | on their code, addressing possible edge cases or performance issues. Tests can 25 | fail when the output doesn't match, or when a execution time limit is reached. 26 | Users get feedback about exactly why their code failed so they can target their 27 | development. 28 | 29 | When successful, a random congratulatory message is displayed to the user. 30 | 31 | `riddlr` comes with hooks for triggering additional actions when a riddle is 32 | submitted, gather data about what was submitted and the result of execution, 33 | allowing for logging. 34 | 35 | #### Applications 36 | 37 | Aside from being a pretty cool app, this demo is intended to provide a 38 | foundation for some community-driven tools for learning R. We all benefit from 39 | having easy tools to learn and develop R skills. 40 | 41 | This code is all released under the `MIT` license so that companies can use it 42 | for interview evaluations, providing a rigorous, extendable and effective way of 43 | providing targetted programming examples that are more akin to a real 44 | programming environment. Unlike typical whiteboarding-style programming 45 | assessments, this gives users the flexibility to use the packages they're 46 | comfortable with (granted they're installed on the system), code autocompletion, 47 | parameter tooltips, realtime syntax error feedback, access to help documentation 48 | and the ability to iterate on their code. The submission hooks are intended to 49 | provide an easy way of capturing multiple submissions so that a user or 50 | interviewee's iterative coding can be evaluated in addition to their final 51 | result. 52 | -------------------------------------------------------------------------------- /R/run_riddle.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | run_riddle <- function(user_code, timeout = Inf, envir = parent.frame()) { 3 | envir <- as.environment(envir) 4 | parent.env(envir) <- riddlr_base_env 5 | 6 | user_expr <- parse_safe(text = user_code) 7 | 8 | if (is_error(user_expr)) 9 | return(parse_error_response(user_expr)) 10 | 11 | user_result <- eval_with_timeout(user_expr, 12 | timeout = timeout, 13 | envir = new.env(parent = envir)) 14 | 15 | if (is_timeout_error(user_result)) 16 | return(simple_timeout_response(user_result, timeout)) 17 | 18 | if (is_error(user_result)) 19 | return(simple_error_response(user_result)) 20 | 21 | if (is_warning(user_result)) 22 | return(simple_warning_response(user_result)) 23 | 24 | simple_console_response(user_result) 25 | } 26 | 27 | 28 | 29 | build_console_out <- function(exprs, console) { 30 | if (length(exprs) == length(console)) { 31 | gsub("(^\\n+|\\n+$)", "", paste0( 32 | paste0("> ", as.character(exprs), " \n"), 33 | ifelse(sapply(console, length) > 0 & sapply(console, nchar) > 0, 34 | paste0(console, " \n"), ""), 35 | collapse = "")) 36 | } else if (!is.null(console)) { 37 | paste(console, collapse = " \n") 38 | } else { 39 | "" 40 | } 41 | } 42 | 43 | 44 | 45 | simple_timeout_response <- function(x, timeout = Inf) { 46 | list(message = paste0( 47 | "**Timeout**: Your code timed out ", 48 | if (is.finite(timeout)) 49 | sprintf("after running for %ds", ceiling(timeout)), 50 | ".", 51 | if (!is.null(console <- attr(x, "console"))) 52 | sprintf(" \n \n``` \n%s \n```", 53 | paste(console, collapse = " \n"))), 54 | class = c("alert", "alert-warning")) 55 | } 56 | 57 | 58 | 59 | simple_error_response <- function(x) { 60 | console.out <- build_console_out(attr(x, "expr"), attr(x, "console")) 61 | 62 | list(message = paste0( 63 | if (nchar(console.out)) 64 | sprintf("**Console Output**: \n``` \n%s \n``` \n", console.out), 65 | sprintf("**Error**: \n``` \n%s \n```", x$message)), 66 | class = c("alert", "alert-danger")) 67 | } 68 | 69 | 70 | 71 | simple_warning_response <- function(x) { 72 | print('attempt to build simple warning') 73 | console.out <- build_console_out(attr(x, "expr"), attr(x, "console")) 74 | 75 | list(message = paste0( 76 | if (nchar(console.out)) 77 | sprintf("**Console Output**: \n``` \n%s \n``` \n", console.out), 78 | sprintf("**Warning**: \n``` \n%s \n```", 79 | paste(lapply(attr(x, "warnings"), "[[", "message"), collapse = " \n"))), 80 | class = c("alert", "alert-warning")) 81 | } 82 | 83 | 84 | 85 | simple_console_response <- function(x) { 86 | console.out <- build_console_out(attr(x, "expr"), attr(x, "console")) 87 | 88 | list(message = paste0( 89 | if (nchar(console.out)) 90 | sprintf("**Console Output**: \n``` \n%s \n``` \n", console.out), 91 | sprintf("``` \n%s \n```", paste(capture.output(x), collapse = " \n"))), 92 | class = c("alert", "alert-info")) 93 | } 94 | -------------------------------------------------------------------------------- /R/shiny_riddlr_module.R: -------------------------------------------------------------------------------- 1 | #' 2 | #' @importFrom shinyAce aceEditor 3 | #' @export 4 | #' 5 | riddle_ui <- function(inputId, label = NULL, question_ui, metadata = list(), 6 | ace = metadata$ace) { 7 | 8 | title <- label %||% metadata$title %||% "Question" 9 | subtitle <- metadata$subtitle %||% sprintf("by %s", metadata$author) %||% NULL 10 | 11 | ns <- NS(inputId) 12 | 13 | aceEditor_hotkeys <- list(list( 14 | win = "Ctrl-R|Ctrl-Shift-Enter", 15 | mac = "CMD-ENTER|CMD-SHIFT-ENTER")) 16 | names(aceEditor_hotkeys) <- ns("ace_editor_run") 17 | 18 | aceEditor_defaults <- list( 19 | autoScrollEditorIntoView = TRUE, 20 | minLines = 15, 21 | maxLines = 25, 22 | autoComplete = "live", 23 | autoCompleters = "rlang") 24 | 25 | aceEditor_fixed <- list( 26 | outputId = ns("riddle_input"), 27 | mode = "r", 28 | hotkeys = aceEditor_hotkeys) 29 | 30 | aceEditor_args <- Reduce(modifyList, list( 31 | aceEditor_defaults, 32 | ace %||% list(), 33 | aceEditor_fixed)) 34 | 35 | tagList( 36 | riddlr_css(), 37 | h2(title), 38 | if (!is.null(subtitle)) h4(subtitle) else list(), 39 | question_ui, 40 | h2("Solution"), 41 | do.call(shinyAce::aceEditor, aceEditor_args), 42 | div( 43 | class = "riddlr-run-btns", 44 | actionButton(ns("riddle_run"), "Run", icon = icon("angle-right")), 45 | modifyCssClasses( 46 | actionButton(ns("riddle_submit"), "Submit", icon = icon("check-square")), 47 | -btn-default, btn-primary)), 48 | uiOutput(ns("riddle_output"))) 49 | } 50 | 51 | 52 | 53 | #' 54 | #' @importFrom shinyAce aceAutocomplete aceAnnotate aceTooltip 55 | #' @importFrom shiny is.reactive reactiveVal observeEvent renderUI tagList h2 56 | #' @export 57 | #' 58 | riddle <- function(input, output, session, solution, test_inputs, test_details, 59 | test_timeouts, quoted = FALSE, clear = reactive(TRUE)) { 60 | 61 | ns <- session$ns 62 | 63 | ace_completer <- shinyAce::aceAutocomplete("riddle_input") 64 | ace_annotater <- shinyAce::aceAnnotate("riddle_input") 65 | ace_tooltip <- shinyAce::aceTooltip("riddle_input") 66 | 67 | if (!shiny::is.reactive(clear)) clear <- reactive(clear) 68 | 69 | riddle_result <- shiny::reactiveVal() 70 | shiny::observeEvent(clear(), riddle_result(NULL)) 71 | 72 | shiny::observeEvent(input$riddle_submit, { 73 | riddle_result(riddle_response_html(grade_riddle( 74 | input$riddle_input, 75 | test_timeouts = test_timeouts, 76 | test_inputs = test_inputs, 77 | solution = solution, 78 | quoted = quoted 79 | ))) 80 | }, ignoreNULL = TRUE, ignoreInit = TRUE) 81 | 82 | shiny::observeEvent({ input$ace_editor_run; input$riddle_run }, { 83 | riddle_result(riddle_response_html(run_riddle( 84 | input$riddle_input, 85 | timeout = test_timeouts[[1]] * 10, 86 | envir = test_inputs[[1]]))) 87 | }, ignoreNULL = TRUE, ignoreInit = TRUE) 88 | 89 | output$riddle_output <- shiny::renderUI({ 90 | if (is.null(riddle_result())) return() 91 | shiny::tagList( 92 | shiny::h2("Output"), 93 | riddle_result()) 94 | }) 95 | 96 | NULL 97 | } 98 | -------------------------------------------------------------------------------- /inst/example/questions/q3.riddlr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Unit Conversions" 3 | # author: "Your Name" # Optionally take some credit for submitting a question! 4 | difficulty: 0.3 5 | tags: 6 | - vectors 7 | details: > 8 | Convert a timespan in years to more human-readable timespans 9 | --- 10 | 11 | 12 | # Question 13 | 14 | You're given a numeric vector of ages in years for people ranging from just a 15 | few seconds old to nearly 100 years old. For printing, you would prefer to use 16 | the largest unit for which the age rounds down to a positive integer (e.g. **"33 17 | mins old"** instead of **"6.46e-5 years old"**). Additionally, you want to 18 | indicate a plural unit when the next lowest positive integer is greater than 1. 19 | 20 | For unit conversions, a numeric vector, `conversions`, has been provided to 21 | convert from years according to the following conversions: 22 | 23 | ```{} 24 | conversions <- c( 25 | year = 1, # 1 year = 1 year 26 | month = 365.25/30.5, # 1 year = 365.25 days 27 | week = 365.25/7, # 1 week = 7 days 28 | day = 365.25, # 1 month = 30.5 days 29 | hour = 365.25*24, # 1 day = 24 hours 30 | min = 365.25*24*60, # 1 hour = 60 mins 31 | sec = 365.25*24*60*60) # 1 min = 60 secs 32 | ``` 33 | 34 | For example, given the following ages in years 35 | 36 | ```{} 37 | ages <- c(0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1, 1, 10) 38 | ``` 39 | 40 | Your resulting character vector would be 41 | 42 | ```{} 43 | c("31 secs old", "5 mins old", "52 mins old", "8 hours old", "3 days old", 44 | "1 month old", "1 year old", "10 years old") 45 | ``` 46 | 47 | 48 | 49 | 50 | ```{r grader} 51 | conversions <- c( 52 | year = 1, 53 | month = 365.25/30.5, 54 | week = 365.25/7, 55 | day = 365.25, 56 | hour = 365.25*24, 57 | min = 365.25*24*60, 58 | sec = 365.25*24*60*60) 59 | 60 | test_inputs <- list( 61 | list(conversions = conversions, 62 | ages = c(0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1, 1, 10)), 63 | # test example input 64 | list(conversions = conversions, 65 | ages = 1*10 ^ (-6:1)), 66 | # test random input 67 | list(conversions = conversions, 68 | ages = 1*10 ^ runif(5, min = -6, max = 2)), 69 | # test case len(ages) == 1 70 | list(conversions = conversions, 71 | ages = 1*10 ^ runif(1, min = -6, max = 2)), 72 | # test long input 73 | list(conversions = conversions, 74 | ages = 1*10 ^ runif(5000, min = -6, max = 2))) 75 | 76 | list( 77 | test_inputs = test_inputs, 78 | test_timeouts = 0.1, 79 | solution = quote({ 80 | m <- floor(ifelse((m <- ages %*% t(conversions)) >= 1, m, NA)) 81 | i <- apply(m, 1, Position, f = Negate(is.na)) 82 | v <- setNames(Map("[", split(m, row(m)), i), colnames(m)[i]) 83 | paste0(v, " ", names(v), ifelse(v>1, "s", ""), " old") 84 | }), 85 | quoted = TRUE) 86 | ``` 87 | 88 | ```{r starter, eval = FALSE} 89 | # already in environment: 90 | # ages (numeric vector; 0.000001 <= value <= 100; 1 <= length <= 10,000) 91 | # conversions (named numeric vector of unit conversions [n/year]) 92 | 93 | print(ages) 94 | print(round(conversions)) 95 | ``` 96 | 97 | -------------------------------------------------------------------------------- /R/parse_riddlr_rmd.R: -------------------------------------------------------------------------------- 1 | #' 2 | #' @importFrom rmarkdown yaml_front_matter 3 | #' @export 4 | #' 5 | parse_riddlr_dir_headers <- function(path, pattern = ".riddlr.Rmd") { 6 | files <- list.files(path, pattern = pattern, full.names = TRUE) 7 | names(files) <- files 8 | unname(Map(function(filepath) { 9 | i <- rmarkdown::yaml_front_matter(filepath) 10 | i$filepath <- filepath 11 | i 12 | }, files)) 13 | } 14 | 15 | 16 | 17 | #' 18 | #' @importFrom rmarkdown render html_fragment 19 | #' @export 20 | #' 21 | parse_riddlr_rmd <- function(file, 22 | text = paste0(readLines(file, warn = FALSE), collapse = "\n")) { 23 | 24 | chunks <- split_header(text) 25 | header <- chunks[,"header"] 26 | chunks <- split_chunks(chunks[,"body"]) 27 | 28 | grader <- tryCatch( 29 | eval(parse(text = chunks$grader), envir = new.env(parent = topenv())), 30 | error = function(e) { 31 | message("An error was encountered while trying to evaluate ", 32 | "chunk \"grader\"") 33 | stop(e) 34 | }) 35 | 36 | starter <- trimws(chunks$starter) 37 | chunks <- chunks[-which(names(chunks) %in% c("grader", "starter"))] 38 | chunks <- trimws(paste(chunks, collapse = "\n")) 39 | 40 | tryCatch({ 41 | tmp_in <- tempfile(fileext = ".Rmd") 42 | tmp_out <- tempfile(fileext = ".html") 43 | cat(chunks, file = tmp_in) 44 | rmarkdown::render(tmp_in, 45 | output_format = rmarkdown::html_fragment(), 46 | output_file = tmp_out, 47 | quiet = TRUE) 48 | }, error = function(e) { 49 | message("An error was encountered while attempting to render remaining ", 50 | "chunks to markdown") 51 | stop(e) 52 | }) 53 | 54 | metadata <- yaml::read_yaml(text = header) 55 | metadata$ace$value <- starter 56 | 57 | list( 58 | metadata = metadata, 59 | prompt = HTML(paste(readLines(tmp_out), collapse = "\n")), 60 | grader = grader) 61 | } 62 | 63 | 64 | split_header <- function(x) { 65 | re_match <- gregexpr("(?s)---(?
.*)---(?.*)", x, perl = TRUE)[[1]] 66 | re_capture <- substring(x, 67 | cs <- attr(re_match, "capture.start"), 68 | cs + attr(re_match, "capture.length") - 1) 69 | dim(re_capture) <- dim(attr(re_match, "capture.start")) 70 | colnames(re_capture) <- attr(re_match, "capture.names") 71 | re_capture 72 | } 73 | 74 | 75 | split_chunks <- function(x) { 76 | chunk_re <- paste0( 77 | "(?s)```\\{\\s*", # start of chunk header 78 | "(?\\w+)", # engine name 79 | "\\s*", # possible spaces 80 | "(?[^,}]*)", # chunk name 81 | "(?,[^,}]*)*", # additional header args 82 | "\\}", # chunk start # to end of chunk header 83 | "(?(?:.(?% 21 | parse_riddlr_dir_headers() %>% 22 | lapply(new_tibble, nrow = 1) %>% 23 | enframe() %>% 24 | mutate(value = map(value, . %>% mutate(tags = paste(tags, collapse = "; ")))) %>% 25 | unnest(value) %>% 26 | select(difficulty, title, details, tags, filepath) 27 | 28 | ui <- dashboardPage( 29 | skin = "green", 30 | dashboardHeader(title = "riddlr"), 31 | dashboardSidebar( 32 | # Custom CSS to hide the default logout panel 33 | tags$head(tags$style(HTML('.shiny-server-account { display: none; }'))), 34 | uiOutput("userpanel"), # The dynamically-generated user panel 35 | uiOutput('sidebar_menu')), 36 | dashboardBody( 37 | riddlr_css(), 38 | tabItems( 39 | tabItem("welcome", fluidPage( 40 | tags$h1("riddlr"), 41 | tags$a(href="https://github.com/dgkf/riddlr", 42 | tags$img(src = "riddlr/hex-riddlr.png", align = "right", style = "margin: 2em; margin-top: -2em;")), 43 | includeMarkdown(system.file( 44 | "example", "shiny", "question_catalog", "welcome.md", 45 | package = "riddlr")) 46 | )), 47 | tabItem("catalog", fluidPage( 48 | tags$h2("Riddle Catalog"), 49 | tags$p( 50 | "Explore a list of available questions. Click on the ", 51 | tags$span(icon("terminal"), style = "margin: 0.5em"), 52 | " to launch a riddle."), 53 | dataTableOutput("riddle_catalog") 54 | )), 55 | tabItem("riddle", fluidPage(withSpinner(uiOutput("riddle_tab")))) 56 | ))) 57 | 58 | server <- function(input, output, session) { 59 | catalog_html <- reactive({ 60 | catalog %>% 61 | # convert difficulty to dot scale 62 | mutate(difficulty = pmax((difficulty * 5) %% 5, 0.5)) %>% 63 | mutate(difficulty = map_chr(difficulty, function(n) { 64 | do.call(tagList, if_else( 65 | n >= 1:5, list(icon("circle")), if_else( 66 | n >= 1:5 - 0.5, list(icon("adjust")), 67 | list(shiny::tags$i(class = 'far fa-circle')) 68 | ))) %>% 69 | span(style = "white-space: nowrap;") %>% 70 | as.character() 71 | })) %>% 72 | 73 | # add buttons 74 | mutate(button = map_chr(row_number(), ~{ 75 | as.character(actionButton( 76 | inputId = paste0("riddle_start_btn_", .), 77 | label = NULL, 78 | icon = icon("terminal"))) 79 | })) %>% 80 | select(button, everything()) %>% 81 | 82 | # add tags 83 | mutate(tags = map_chr(tags, ~paste( 84 | map(trimws(strsplit(., ";")[[1]]), ~ 85 | as.character(shiny::tags$span(., class = "badge badge-primary"))), 86 | collapse = ""))) %>% 87 | 88 | # bold riddle titles 89 | mutate(title = map_chr(title, ~as.character(shiny::tags$strong(.)))) %>% 90 | 91 | # reorder columns 92 | select(button, title, details, difficulty, tags, everything()) 93 | }) 94 | 95 | output$userpanel <- renderUI({ 96 | # session$user is non-NULL only in authenticated sessions 97 | if (!is.null(session$user)) { 98 | sidebarUserPanel( 99 | span(icon("user-circle"), session$user), 100 | subtitle = a(icon("sign-out"), "Logout", href="__logout__")) 101 | } 102 | }) 103 | 104 | output$riddle_catalog <- renderDataTable({ 105 | catalog_html() %>% 106 | select(-filepath) %>% 107 | datatable( 108 | style = "bootstrap", 109 | escape = FALSE, 110 | colnames = c(" " = "button"), 111 | rownames = FALSE, 112 | autoHideNavigation = TRUE, 113 | selection = "single") 114 | }) 115 | 116 | updateTabItems(session, "tabs", "welcome") 117 | output$sidebar_menu <- renderUI({ 118 | welcome <- menuItem("Welcome", tabName = "welcome", icon = icon("play")) 119 | catalog <- menuItem("Catalog", tabName = "catalog", icon = icon("list")) 120 | riddle <- menuItem("Riddle", tabName = "riddle", icon = icon("question-circle")) 121 | 122 | items <- c( 123 | list( 124 | welcome = welcome, 125 | catalog = catalog), 126 | if (!is.null(riddle_num())) list(riddle = riddle)) 127 | 128 | updateTabItems(session, "tabs", selected = "riddle") 129 | do.call(sidebarMenu, append( 130 | list(id = "tabs"), 131 | Filter(Negate(is.null), unname(items)))) 132 | }) 133 | 134 | riddle_num <- reactiveVal() 135 | observeEvent(input$riddle_catalog_rows_selected, ignoreNULL = TRUE, { 136 | updateTabItems(session, "tabs", selected = "riddle") 137 | riddle_num(input$riddle_catalog_row_last_clicked) 138 | selectRows(dataTableProxy("riddle_catalog"), c()) 139 | }) 140 | 141 | riddle_spec <- eventReactive(riddle_num(), ignoreNULL = TRUE, ignoreInit = TRUE, { 142 | parse_riddlr_rmd(catalog_html()$filepath[[riddle_num()]]) 143 | }) 144 | 145 | output$riddle_tab <- renderUI({ 146 | r <- riddle_spec() 147 | riddle_ui("riddle", question_ui = r$prompt, metadata = r$metadata) 148 | }) 149 | 150 | observe({ 151 | r <- riddle_spec() 152 | callModule(riddle, "riddle", 153 | solution = r$grader$solution, 154 | quoted = TRUE, 155 | test_inputs = r$grader$test_inputs, 156 | test_timeouts = r$grader$test_timeouts, 157 | clear = riddle_spec) # clear output reactively upon update 158 | }) 159 | } 160 | 161 | shinyApp(ui, server) 162 | -------------------------------------------------------------------------------- /R/grade_riddle.R: -------------------------------------------------------------------------------- 1 | #' function for generating an exercise checker for a puzzlr challenge 2 | #' 3 | #' @param envs environments in which solution should be evaluated. these should 4 | #' contain the necessary input variables for the challenge. 5 | #' @param solution solution code 6 | #' 7 | #' @return A shiny ui element displaying output from grading the question 8 | #' solution. 9 | #' 10 | #' @importFrom shiny withProgress setProgress 11 | #' @export 12 | #' 13 | grade_riddle <- function(user_code, solution, test_inputs, test_timeouts = Inf, 14 | grace_timeouts = test_timeouts * 5, 15 | test_details = rep(list(NULL), length(test_inputs)), 16 | quoted = FALSE) { 17 | 18 | n <- length(test_inputs) 19 | 20 | # validate test inputs and ensure they have initialized value 21 | if (!length(test_timeouts)) test_timeouts <- 5 22 | if (!length(grace_timeouts)) grace_timeouts <- test_timeouts * 5 23 | if (!length(test_details)) test_details <- rep(list(NULL), length(test_inputs)) 24 | 25 | shiny::withProgress( 26 | message = 'parsing input...', 27 | min = -1, 28 | max = n, 29 | value = -1, { 30 | 31 | .exit_response_type <- "riddlr_error" 32 | 33 | test_timeouts <- rep_len(test_timeouts, n) 34 | grace_timeouts <- rep_len(grace_timeouts, n) 35 | test_details <- rep_len(test_details, n) 36 | if (!quoted) solution <- as.list(match.call())$solution 37 | 38 | .total_duration <- 0L 39 | 40 | # call submission callback whenever function completes 41 | on.exit({ 42 | opts$get("onSubmit")(user_code, .total_duration, .exit_response_type) 43 | }) 44 | 45 | # attempt to parse user code, display errors/warnings if necessary 46 | user_expr <- parse_safe(text = user_code) 47 | 48 | if (is_error(user_expr)) { 49 | .exit_response_type <- "syntax" 50 | return(parse_error_response(user_expr)) 51 | } 52 | 53 | # test against test cases 54 | .total_duration <- 0 55 | for (i in seq_along(test_inputs)) { 56 | setProgress(i - 1, 57 | message = sprintf("running test case %d...", i), 58 | detail = test_details[[i]]) 59 | 60 | envir <- as.environment(test_inputs[[i]]) 61 | parent.env(envir) <- riddlr_base_env 62 | 63 | user_soln <- eval_with_timeout(user_expr, 64 | timeout = grace_timeouts[[i]], 65 | envir = new.env(parent = envir)) 66 | 67 | if (is_timeout_error(user_soln)) { 68 | .exit_response_type <- "timeout" 69 | return(timeout_response(user_soln, NULL, test_inputs[[i]], i, n)) 70 | } 71 | 72 | if (is_error(user_soln)) { 73 | .exit_response_type <- "error" 74 | return(error_response(user_soln, NULL, test_inputs[[i]], i, n)) 75 | } 76 | 77 | soln <- eval_with_timeout(solution, envir = new.env(parent = envir)) 78 | 79 | if (user_soln != soln) { 80 | .exit_response_type <- "incorrect" 81 | return(incorrect_solution_response(user_soln, soln, test_inputs[[i]], i, n)) 82 | } 83 | 84 | if (attr(user_soln, "duration")["elapsed"] > test_timeouts[[i]]) { 85 | .exit_response_type <- "grace_timeouts" 86 | return(grace_timeouts_response(user_soln, soln, test_inputs[[i]], i, n, 87 | attr(user_soln, "duration")["elapsed"] / test_timeouts[[i]])) 88 | } 89 | 90 | .total_duration <- .total_duration + attr(user_soln, "duration")["elapsed"] 91 | } 92 | 93 | shiny::setProgress(n, message = "done running tests...") 94 | 95 | # success! 96 | .exit_response_type <- "success" 97 | success_response(hash = solution) 98 | }) 99 | } 100 | 101 | 102 | 103 | #' Format test results as html for updating progress text 104 | #' 105 | #' @importFrom shiny tagList 106 | #' 107 | update_test_progress_html <- function(test_results, reactive_output) { 108 | if (is.null(reactive_output)) return(tagList()) 109 | reactive_output(do.call(shiny::tagList, Map( 110 | test_results, 111 | seq_along(test_results), 112 | f = function(t, i) { 113 | if (isTRUE(t)) 114 | tags$span(icon("check"), sprintf("Test %d", i)) 115 | else if (is.na(t)) 116 | tags$span(icon("hourglass-half"), sprintf("Test %d", i)) 117 | else 118 | tags$span(icon("times"), sprintf("Test %d", i)) 119 | }))) 120 | } 121 | 122 | 123 | 124 | #' Parsing with error handling 125 | #' 126 | parse_safe <- function(...) { 127 | riddlr_result(tryCatch(parse(...), error = function(e) e)) 128 | } 129 | 130 | 131 | 132 | #' Evaluate and memoise solution execution 133 | #' 134 | #' @importFrom memoise memoise 135 | #' 136 | eval_with_timeout <- memoise::memoise( 137 | function(x, timeout = Inf, envir = parent.frame()) { 138 | 139 | .duration <- NULL 140 | 141 | # break down code into top level expressions 142 | xs <- if (is.expression(x) && length(x)) as.list(x) else list(x) 143 | 144 | # itrate through expressions, collecting console output 145 | .console <- rep(list(""), length(xs)) 146 | .w <- list() 147 | .e <- withCallingHandlers( 148 | tryCatch({ 149 | setTimeLimit(timeout, timeout, TRUE) 150 | with_env_cleanup({ 151 | .duration <- system.time(for (i in seq_along(xs)) { 152 | .console[[i]] <- paste(capture.output( 153 | u <- eval(bquote(with(envir, .(xs[[i]]))))), 154 | collapse = "\n") 155 | }) 156 | }) 157 | setTimeLimit(Inf, Inf) 158 | TRUE 159 | }, 160 | error = function(e) e), 161 | warning = function(w) { 162 | .w <<- append(.w, list(w)) 163 | invokeRestart('muffleWarning') 164 | }) 165 | setTimeLimit(Inf, Inf) 166 | 167 | if (inherits(.e, "error")) 168 | riddlr_result(.e, expr = xs, console = .console) 169 | else 170 | riddlr_result(u, expr = xs, duration = .duration, console = .console, 171 | warnings = .w %||% NULL) 172 | }) 173 | 174 | 175 | 176 | #' Format a riddlr response as HTML output 177 | #' 178 | #' @importFrom shiny div HTML 179 | #' @importFrom markdown markdownToHTML 180 | #' @export 181 | #' 182 | riddle_response_html <- function(x) { 183 | class <- c(x$class, "riddlr-alert") 184 | class_inner <- setdiff(class, "alert") 185 | 186 | class <- paste(class, collapse = " ") 187 | class_inner <- paste(class_inner, collapse = " ") 188 | 189 | shiny::div( 190 | class = class, 191 | shiny::HTML( 192 | # silly hack to inherit alert stylings 193 | gsub("<(code|pre)>", sprintf("<\\1 class='%s'>", class_inner), 194 | markdown::markdownToHTML( 195 | text = x$message, 196 | fragment.only = TRUE, 197 | stylesheet = "")))) 198 | } 199 | 200 | 201 | 202 | #' Response for an incorrect solution 203 | #' 204 | #' @importFrom shiny HTML 205 | #' @importFrom markdown markdownToHTML 206 | #' 207 | incorrect_solution_response <- function(user_output, solution_output, 208 | input_env, test_i, test_n, err) { 209 | 210 | list( 211 | message = sprintf(paste0( 212 | "Sorry, your code failed on one of the test cases (%s of %s). ", 213 | " \n \n", 214 | "**Your Solution:** \n``` \n%s \n```", 215 | " \n \n", 216 | "**Correct Solution:** \n``` \n%s \n```", 217 | " \n \n", 218 | "**Input:** \n``` \n%s \n```"), 219 | test_i, test_n, 220 | paste(capture.output(user_output), collapse = ' \n'), 221 | paste(capture.output(solution_output), collapse = ' \n'), 222 | paste(capture.output(as.list(input_env)), collapse = ' \n')), 223 | class = c("alert", "alert-warning")) 224 | } 225 | 226 | 227 | 228 | 229 | #' Response for a solution that times out 230 | #' 231 | #' @importFrom shiny HTML 232 | #' @importFrom markdown markdownToHTML 233 | #' 234 | #' @export 235 | #' 236 | timeout_response <- function(x, solution_output, 237 | input_env, test_i, test_n) { 238 | 239 | list( 240 | message = sprintf(paste0( 241 | "Sorry, your code was terminated prematurely for taking ", 242 | "too long to execute while running test case (%s of %s). ", 243 | " \n \n**Input:** \n``` \n%s \n```"), 244 | test_i, test_n, 245 | paste(capture.output(as.list(input_env)), collapse = ' \n')), 246 | class = c("alert", "alert-warning")) 247 | } 248 | 249 | 250 | 251 | #' Response for a solutions that produce errors 252 | #' 253 | #' @importFrom shiny HTML 254 | #' @importFrom markdown markdownToHTML 255 | #' 256 | #' @export 257 | #' 258 | parse_error_response <- function(x, ...) { 259 | list( 260 | message = sprintf(paste0( 261 | "**Error:** \n``` \n%s \n```"), 262 | paste(capture.output(cat(x$message)), collapse = ' \n')), 263 | class = c("alert", "alert-danger")) 264 | } 265 | 266 | 267 | 268 | #' Response for a solutions that produce errors 269 | #' 270 | #' @importFrom shiny HTML 271 | #' @importFrom markdown markdownToHTML 272 | #' 273 | #' @export 274 | #' 275 | error_response <- function(x, solution_output, 276 | input_env, test_i, test_n) { 277 | 278 | list( 279 | message = sprintf(paste0( 280 | "Sorry, your code encountered an error while running one of ", 281 | "the test cases (%s of %s). ", 282 | " \n \n**Error:** \n``` \n%s \n```"), 283 | test_i, test_n, 284 | paste(capture.output(cat(x$message)), collapse = ' \n')), 285 | class = c("alert", "alert-danger")) 286 | } 287 | 288 | 289 | 290 | #' Response for a solution that times out only a grace period 291 | #' 292 | #' @importFrom shiny HTML 293 | #' @importFrom markdown markdownToHTML 294 | #' 295 | #' @export 296 | #' 297 | grace_timeouts_response <- function(user_output, solution_output, input_env, 298 | test_i, test_n, time_frac) { 299 | 300 | list( 301 | message = sprintf(paste0( 302 | "Sorry, although your solution was correct, your code ", 303 | "took too long to run on one of ", 304 | "the test cases (%s of %s). Your code took **%.2fx** the ", 305 | "allowed time and was terminated before evaluating further ", 306 | "test cases."), 307 | test_i, test_n, time_frac), 308 | class = c("alert", "alert-warning")) 309 | } 310 | 311 | 312 | 313 | #' Response for successful solution 314 | #' 315 | #' @importFrom shiny HTML 316 | #' @importFrom markdown markdownToHTML 317 | #' 318 | #' @export 319 | #' 320 | success_response <- function(hash = runif(1)) { 321 | congrats <- list( 322 | paste("Nice job", icon("thumbs-up")), 323 | paste("Cheers", icon("beer")), 324 | paste("That went swimmingly", icon("swimmer")), 325 | paste("Code cracked", icon("code")), 326 | paste("Top notch", icon("award")), 327 | # paste("Like taking candy from a baby", icon("baby-carriage")), 328 | paste("Brainiac", icon("brain")), 329 | paste("Moving on up", icon("chart-line")), 330 | paste("The magic touch", icon("fingerprint")), 331 | paste("Touchdown", icon("football-ball")), 332 | # paste("That's the spirit", icon("ghost")), 333 | paste("Goooooooal", icon("futbol")), 334 | paste("Wizkid", icon("graduation-cap")), 335 | # paste("Smarty cat", icon("cat")), 336 | paste("Briliant", icon("lightbulb")), 337 | paste("Award winning", icon("medal")), 338 | # paste("You pieced it together", icon("puzzle-piece")), 339 | # paste("One solution to rule them all", icon("ring")), 340 | paste("Full throttle", icon("tachometer-alt")), 341 | paste("That's the ticket", icon("ticket-alt")), 342 | paste("Have a trophy", icon("trophy")), 343 | paste("A winning formula", icon("vial")), 344 | paste("Certified awesome", icon("certificate")), 345 | paste("Eureka", icon("apple-alt"))) 346 | 347 | # poor man's hash 348 | i <- sum(utf8ToInt(capture.output(hash))) %% length(congrats) + 1 349 | 350 | list( 351 | message = paste0( 352 | "## ", congrats[[i]], " \n", 353 | "Your solution passes all the test cases!"), 354 | class = c("alert", "alert-success")) 355 | } 356 | --------------------------------------------------------------------------------