Optionally reveal (or hide) exercise solution (#470)

Co-authored-by: Barret Schloerke <barret@rstudio.com>
Co-authored-by: gadenbuie <gadenbuie@users.noreply.github.com>

NEWS.md

@@ -34,6 +34,7 @@ learnr (development version)
 * Hitting the `TAB` key in an exercise has always opened the auto-completion drop down. Now, hitting the `TAB` key will also complete the currently selected code completion. ([#428](https://github.com/rstudio/learnr/pull/428))
 * `question_text()` gains `rows` and `cols` parameters. If either is provided, a multi-line `textAreaInput()` is used for the text input. ([#460](https://github.com/rstudio/learnr/pull/460), [#455](https://github.com/rstudio/learnr/issues/455))
 * Feedback messages can now be an htmltools tag or tagList, or a character message ([#458](https://github.com/rstudio/learnr/pull/458))
+* Added an option to reveal [default] (or hide) the solution to an exercise. Set `exercise.reveal_solution` in the chunk options of a `*-solution` chunk to choose whether or not the solution is revealed to the user. The option can also be set globally with `tutorial_options()`. In a future version of learnr, the default will be changed to hide solutions. ([#402](https://github.com/rstudio/learnr/issue/402))
 
 ## Bug fixes
 

R/knitr-hooks.R

@@ -47,7 +47,7 @@ install_knitr_hooks <- function() {
         TRUE
       } else {
         # if this looks like a setup chunk, but no one references it, error
-        if (is.null(options$exercise) && !is.null(options$exercise.setup)) {
+        if (is.null(options[["exercise"]]) && !is.null(options$exercise.setup)) {
           stop(
             "Chunk '", options$label, "' is not being used by any exercise or exercise setup chunk.\n",
             "Please remove chunk '", options$label, "' or reference '", options$label, "' with `exercise.setup = '", options$label, "'`",
@@ -135,6 +135,32 @@ install_knitr_hooks <- function() {
     append(setup_chunks, list(list(label = options$label, code = exercise_chunk, opts = chunk_opts, engine = knitr_engine(options$engine))))
   }
 
+  get_reveal_solution_option <- function(solution_opts) {
+    exercise_chunk <- get_knitr_chunk(sub("-solution$", "", solution_opts$label))
+    if (is.null(exercise_chunk)) {
+      stop("Can not find exercise chunk for solution: `", solution_opts$label, "`")
+    }
+
+    # these are unevaluated options at this point
+    exercise_opts <- attr(exercise_chunk, "chunk_opts")
+    # get explicit opts on solution chunk since solution_opts was merged
+    # with the global knitr chunk options
+    sol_opts_user <- attr(get_knitr_chunk(solution_opts$label), "chunk_opts")
+
+    # Determine if we should reveal the solution using...
+    reveal_solution <-
+      # 1. the option explicitly set on the solution chunk
+      eval(sol_opts_user$exercise.reveal_solution, envir = knitr::knit_global()) %||%
+      # 2. the option explicitly set on the exercise chunk
+      eval(exercise_opts$exercise.reveal_solution, envir = knitr::knit_global()) %||%
+      # 3. the global knitr chunk option
+      solution_opts$exercise.reveal_solution %||%
+      # 4. the global R option
+      getOption("tutorial.exercise.reveal_solution", TRUE)
+
+    isTRUE(reveal_solution)
+  }
+
   # hook to turn off evaluation/highlighting for exercise related chunks
   knitr::opts_hooks$set(tutorial = function(options) {
 
@@ -189,6 +215,11 @@ install_knitr_hooks <- function() {
       options$include <- FALSE
     }
 
+    if (is_exercise_support_chunk(options, type = "solution")) {
+      # only print solution if exercise.reveal_solution is TRUE
+      options$echo <- get_reveal_solution_option(options)
+    }
+
     # if this is an exercise setup chunk then eval it if the corresponding
     # exercise chunk is going to be executed
     if (exercise_setup_chunk) {
@@ -392,8 +423,12 @@ install_knitr_hooks <- function() {
 
       # send hint and solution to the browser
       # these are visibly displayed in the UI
-      if (is_exercise_support_chunk(options, type = c("hint", "hint-\\d+", "solution"))) {
+      if (is_exercise_support_chunk(options, type = c("hint", "hint-\\d+"))) {
         exercise_wrapper_div(suffix = "support")
+      } else if (is_exercise_support_chunk(options, type = "solution")) {
+        if (get_reveal_solution_option(options)) {
+          exercise_wrapper_div(suffix = "support")
+        }
       }
 
     }

R/options.R

@@ -18,6 +18,8 @@
 #' @param exercise.completion Use code completion in exercise editors.
 #' @param exercise.diagnostics Show diagnostics in exercise editors.
 #' @param exercise.startover Show "Start Over" button on exercise.
+#' @param exercise.reveal_solution Whether to reveal the exercise solution if
+#'   a solution chunk is provided.
 #'
 #' @export
 tutorial_options <- function(exercise.cap = NULL,
@@ -28,7 +30,8 @@ tutorial_options <- function(exercise.cap = NULL,
                              exercise.error.check.code = NULL,
                              exercise.completion = TRUE,
                              exercise.diagnostics = TRUE,
-                             exercise.startover = TRUE)
+                             exercise.startover = TRUE,
+                             exercise.reveal_solution = TRUE)
 {
   # string to evalute for setting chunk options  %1$s
   set_option_code <- 'if (!missing(%1$s)) knitr::opts_chunk$set(%1$s = %1$s)'
@@ -43,4 +46,5 @@ tutorial_options <- function(exercise.cap = NULL,
   eval(parse(text = sprintf(set_option_code, "exercise.completion")))
   eval(parse(text = sprintf(set_option_code, "exercise.diagnostics")))
   eval(parse(text = sprintf(set_option_code, "exercise.startover")))
+  eval(parse(text = sprintf(set_option_code, "exercise.reveal_solution")))
 }

docs/exercises.Rmd

@@ -54,6 +54,10 @@ Exercises are interactive R code chunks that allow readers to directly execute R
 <td><code>exercise.warn_invisible</code></td>
 <td>Whether to display an invisible result warning if the last value returned is invisible.</td>
 </tr>
+<tr class="odd">
+<td><code>exercise.reveal_solution</code></td>
+<td>Whether or not the solution should be revealed to the user (defaults to `TRUE`). See [Hiding Solutions](#hiding-solutions) below.</td>
+</tr>
 </tbody>
 </table>
 
@@ -142,6 +146,15 @@ For R code hints you can provide a sequence of hints that reveal progressively m
 <div id="exercisehints"></div>
 <script type="text/javascript">loadSnippet('exercisehints')</script>
 
+### Hiding Solutions
+
+By default, the exercise solution is made available to the user with the "Solution" or "Hint" button (if there are hints those will appear first). If you would prefer not to reveal the solution to an exercise, you can disable revealing the solution by adding `exercise.reveal_solution = FALSE` to the chunk options of either the exercise or its corresponding `*-solution` chunk.
+
+<div id="exercisesolutionhidden"></div>
+<script type="text/javascript">loadSnippet('exercisesolutionhidden')</script>
+
+You can also set this option globally in the global `setup` chunk with `tutorial_options()`. When set this way, the chunk-level option will take precedence over the global option so that you can choose to always reveal or hide the solution to a particular exercise. The current default is to reveal exercise solutions, but in a future version of learnr the default behavior will change to hide solutions.
+
 ## Progressive Reveal
 
 You might want users of your tutorials to see only one sub-topic at a time as they work through the material (this can be helpful to reduce distractions and maintain focus on the current task). If you specify the `progressive` option then all Level 3 headings (`###`) will be revealed progressively. For example:

docs/exercises.html

@@ -513,6 +513,14 @@ <h2>Overview</h2>
 Whether to display an invisible result warning if the last value returned is invisible.
 </td>
 </tr>
+<tr class="odd">
+<td>
+<code>exercise.reveal_solution</code>
+</td>
+<td>
+Whether or not the solution should be revealed to the user (defaults to <code>TRUE</code>). See <a href="#hiding-solutions">Hiding Solutions</a> below.
+</td>
+</tr>
 </tbody>
 </table>
 <p>Note that these options can all be specified either globally or per-chunk. For example, the following code sets global default options using the <code>setup</code> chunk and also sets some local options on the <code>addition</code> chunk:</p>
@@ -598,6 +606,15 @@ <h3>Multiple Hints</h3>
 </div>
 <script type="text/javascript">loadSnippet('exercisehints')</script>
 </div>
+<div id="hiding-solutions" class="section level3">
+<h3>Hiding Solutions</h3>
+<p>By default, the exercise solution is made available to the user with the “Solution” or “Hint” button (if there are hints those will appear first). If you would prefer not to reveal the solution to an exercise, you can disable revealing the solution by adding <code>exercise.reveal_solution = FALSE</code> to the chunk options of either the exercise or its corresponding <code>*-solution</code> chunk.</p>
+<div id="exercisesolutionhidden">
+
+</div>
+<script type="text/javascript">loadSnippet('exercisesolutionhidden')</script>
+<p>You can also set this option globally in the global <code>setup</code> chunk with <code>tutorial_options()</code>. When set this way, the chunk-level option will take precedence over the global option so that you can choose to always reveal or hide the solution to a particular exercise. The current default is to reveal exercise solutions, but in a future version of learnr the default behavior will change to hide solutions.</p>
+</div>
 </div>
 <div id="progressive-reveal" class="section level2">
 <h2>Progressive Reveal</h2>

docs/snippets/exercisesolutionhidden.md

@@ -0,0 +1,16 @@
+```{r filter, exercise=TRUE}
+# filter the flights table to include only United and American flights
+flights
+```
+
+```{r filter-hint-1}
+filter(flights, ...)
+```
+
+```{r filter-hint-2}
+filter(flights, UniqueCarrier=="AA")
+```
+
+```{r filter-solution, exercise.reveal_solution = FALSE}
+filter(flights, UniqueCarrier=="AA" | UniqueCarrier=="UA")
+```

tests/testthat/test-chunks-error-check.R

@@ -1,13 +1,15 @@
 test_that("*-error-check chunks require *-check chunks", {
-  skip_on_cran()
+  skip_if_not(rmarkdown::pandoc_available())
+
+  tmpfile <- tempfile(fileext = ".html")
+  on.exit(unlink(tmpfile))
+
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "error-check-chunk_bad.Rmd"), render_args = list(quiet = TRUE)),
+    rmarkdown::render(test_path("setup-chunks", "error-check-chunk_bad.Rmd"), output_file = tmpfile, quiet = TRUE),
     "ex-check",
     fixed = TRUE
   )
 
-  tmpfile <- tempfile(fileext = ".html")
-  on.exit(unlink(tmpfile))
   expect_silent(
     rmarkdown::render(test_path("setup-chunks", "error-check-chunk_good.Rmd"), output_file = tmpfile, quiet = TRUE)
   )

tests/testthat/test-options-reveal_solution.R

@@ -0,0 +1,68 @@
+context("Optionally reveal solution")
+
+render_tutorial_with_reveal_solution <- function(opt_string) {
+  ex <- readLines(test_path("tutorials", "optional-show-solution.Rmd"))
+  ex <- sub("#<<reveal_solution>>", opt_string, ex, fixed = TRUE)
+
+  tut_rmd <- tempfile(fileext = ".Rmd")
+  on.exit(unlink(tut_rmd))
+
+  writeLines(ex, tut_rmd)
+  tut_html <- rmarkdown::render(tut_rmd, quiet = TRUE)
+
+  # overwrite exit handler to remove all tutorial files
+  on.exit({
+    rmarkdown::shiny_prerendered_clean(tut_rmd)
+    unlink(tut_html)
+    unlink(tut_rmd)
+  }, add = FALSE)
+
+  paste(readLines(tut_html), collapse = "\n")
+}
+
+default_solution <- "<code># DEFAULT SOLUTION 4631b0</code>"
+hidden_solution <- "<code># HIDDEN SOLUTION 48da3c</code>"
+shown_solution <- "<code># SHOWN SOLUTION 781cbb</code>"
+ex_opt_solution <- "<code># EXERCISE OPT SOLUTION 15c861</code>"
+var_hide_solution <- "<code># HIDDEN VAR SOLUTION 0b219b</code>"
+var_show_solution <- "<code># SHOWN VAR SOLUTION aba888</code>"
+
+test_that("Solutions are revealed or hidden with tutorial_options()", {
+  skip_if_not(rmarkdown::pandoc_available())
+
+  ex_show <- render_tutorial_with_reveal_solution("tutorial_options(exercise.reveal_solution = TRUE)")
+  expect_match(ex_show, default_solution, fixed = TRUE)
+  expect_failure(expect_match(ex_show, hidden_solution, fixed = TRUE))
+  expect_match(ex_show, shown_solution, fixed = TRUE)
+  expect_match(ex_show, ex_opt_solution, fixed = TRUE)
+  expect_failure(expect_match(ex_show, var_hide_solution, fixed = TRUE))
+  expect_match(ex_show, var_show_solution, fixed = TRUE)
+
+  ex_hide <- render_tutorial_with_reveal_solution("tutorial_options(exercise.reveal_solution = FALSE)")
+  expect_failure(expect_match(ex_hide, default_solution, fixed = TRUE))
+  expect_failure(expect_match(ex_hide, hidden_solution, fixed = TRUE))
+  expect_match(ex_hide, shown_solution, fixed = TRUE)
+  expect_match(ex_hide, ex_opt_solution, fixed = TRUE)
+  expect_failure(expect_match(ex_hide, var_hide_solution, fixed = TRUE))
+  expect_match(ex_hide, var_show_solution, fixed = TRUE)
+})
+
+test_that("Solutions are revealed or hidden with global option", {
+  skip_if_not(rmarkdown::pandoc_available())
+
+  ex_show <- render_tutorial_with_reveal_solution("options(tutorial.exercise.reveal_solution = TRUE)")
+  expect_match(ex_show, default_solution, fixed = TRUE)
+  expect_failure(expect_match(ex_show, hidden_solution, fixed = TRUE))
+  expect_match(ex_show, shown_solution, fixed = TRUE)
+  expect_match(ex_show, ex_opt_solution, fixed = TRUE)
+  expect_failure(expect_match(ex_show, var_hide_solution, fixed = TRUE))
+  expect_match(ex_show, var_show_solution, fixed = TRUE)
+
+  ex_hide <- render_tutorial_with_reveal_solution("options(tutorial.exercise.reveal_solution = FALSE)")
+  expect_failure(expect_match(ex_hide, default_solution, fixed = TRUE))
+  expect_failure(expect_match(ex_hide, hidden_solution, fixed = TRUE))
+  expect_match(ex_hide, shown_solution, fixed = TRUE)
+  expect_match(ex_hide, ex_opt_solution, fixed = TRUE)
+  expect_failure(expect_match(ex_hide, var_hide_solution, fixed = TRUE))
+  expect_match(ex_hide, var_show_solution, fixed = TRUE)
+})

tests/testthat/test-setup-chunks.R

@@ -1,37 +1,41 @@
 test_that("Detection of chained setup cycle works", {
-  skip_on_cran()
+  skip_if_not(rmarkdown::pandoc_available())
+
+  tmpfile <- tempfile(fileext = ".html")
+  on.exit(unlink(tmpfile))
+
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "setup-cycle.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "setup-cycle.Rmd"), output_file = tmpfile, quiet = TRUE),
     "dataA => dataC => dataB => dataA",
     fixed = TRUE
   )
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "setup-cycle-self.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "setup-cycle-self.Rmd"), output_file = tmpfile, quiet = TRUE),
     "dataA => dataA",
     fixed = TRUE
   )
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "setup-cycle-two.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "setup-cycle-two.Rmd"), output_file = tmpfile, quiet = TRUE),
     "dataA => dataB => dataA",
     fixed = TRUE
   )
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "exercise-cycle-default-setup.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "exercise-cycle-default-setup.Rmd"), output_file = tmpfile, quiet = TRUE),
     "data1 => data1-setup => data1",
     fixed = TRUE
   )
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "exercise-cycle.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "exercise-cycle.Rmd"), output_file = tmpfile, quiet = TRUE),
     "data1 => data3 => data2 => data1",
     fixed = TRUE
   )
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "exercise-cycle-self.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "exercise-cycle-self.Rmd"), output_file = tmpfile, quiet = TRUE),
     "data1 => data1",
     fixed = TRUE
   )
   expect_error(
-    rmarkdown::run(test_path("setup-chunks", "exercise-cycle-two.Rmd")),
+    rmarkdown::render(test_path("setup-chunks", "exercise-cycle-two.Rmd"), output_file = tmpfile, quiet = TRUE),
     "data1 => data2 => data1",
     fixed = TRUE
   )