---
title: "Tutorial Quiz Questions in `learnr`"
output:
  learnr::tutorial:
    allow_skip: true
runtime: shiny_prerendered
tutorial:
  # id: "com.example.tutorials.my-first-tutorial"
  version: 2.18
  # user_id: "barret"
description: >
  This tutorial demonstrates how multiple-choice questions can be created within
  a learnr tutorial.
---

```{r setup, include=FALSE}
library(learnr)
knitr::opts_chunk$set(echo = TRUE, highlight = TRUE)
```

## Overview

You can include one or more multiple-choice quiz questions within a tutorial to help verify that readers understand the concepts presented. Basic questions can either have one or more correct answers.

Include a question by calling the `question` function within an R code chunk:

````markdown
```{r letter-a, echo=FALSE}`r ''`
question("What number is the letter A in the English alphabet?",
  answer("8"),
  answer("14"),
  answer("1", correct = TRUE),
  answer("23")
)
```
````



The above example defines a question with a single correct answer. You can also create questions that require multiple answers to be specified:

````markdown
```{r where-am-i, echo=FALSE}`r ''`
question("Where are you right now? (select ALL that apply)",
  answer("Planet Earth", correct = TRUE),
  answer("Pluto"),
  answer("At a computing device", correct = TRUE),
  answer("In the Milky Way", correct = TRUE),
  incorrect = "Incorrect. You're on Earth, in the Milky Way, at a computer."
)
```
````



Note that for the examples above we specify the `echo = FALSE` option on the R code chunks that produce the questions. This is required to ensure that the R source code for the questions is not printed within the document.

This is what the above example quiz questions would look like within a tutorial:


```{r letter-a, echo=FALSE}
question("What number is the letter A in the English alphabet?",
  answer("8"),
  answer("14"),
  answer("1", correct = TRUE),
  answer("23")
)
```

```{r where-am-i, echo=FALSE}
question("Where are you right now? (select ALL that apply)",
  answer("Planet Earth", correct = TRUE),
  answer("Pluto"),
  answer("At a computing device", correct = TRUE),
  answer("In the Milky Way", correct = TRUE),
  incorrect = "Incorrect. You're on Earth, in the Milky Way, at a computer."
)
```

-------------------


### Custom Messages
You can add answer-specific correct/incorrect messages using the `message` option. For example:

````markdown
```{r letter-a-message, echo=FALSE}`r ''`
question("What number is the letter A in the *English* alphabet?",
  answer("8"),
  answer("1", correct = TRUE),
  answer("2", message = "2 is close but it's the letter B rather than A."),
  answer("26")
)
```
````

```{r letter-a-message, echo=FALSE}
question("What number is the letter A in the *English* alphabet?",
  answer("8"),
  answer("1", correct = TRUE),
  answer("2", message = "2 is close but it's the letter B rather than A."),
  answer("26")
)
```

-------------------


### Formatting and Math

You can use markdown to format text within questions, answers, and custom messages. You can also include embedded LaTeX math using the `$` delimiter. For example:

````markdown
```{r math, echo=FALSE}`r ''`
x <- 42
question(sprintf("Suppose $x = %s$. Choose the correct statement:", x),
  answer(sprintf("$\\sqrt{x} = %d$", x + 1)),
  answer(sprintf("$x ^ 2 = %d$", x^2), correct = TRUE),
  answer("$\\sin x = 1$")
)
```
````

Note the use of a double-backslash (`\\`) as the prefix for LaTeX macros. This is necessary to “escape” the single-backslash so that R doesn’t interpret it as a special character. Here’s what this example would look like within a tutorial:

```{r math, echo=FALSE}
x <- 42
question(sprintf("Suppose $x = %s$. Choose the correct statement:", x),
  answer(sprintf("$\\sqrt{x} = %d$", x + 1)),
  answer(sprintf("$x ^ 2 = %d$", x^2), correct = TRUE),
  answer("$\\sin x = 1$")
)
```

-------------------


### Retrying Questions

By default when an incorrect answer is provided users get the appropriate feedback and the correct answer(s) are highlighted. You can also provide an option for the user to try the question again. You can do this using the `allow_retry` option, for example:

````markdown
```{r letter-a-allow-retry, echo=FALSE}`r ''`
question("What number is the letter A in the English alphabet?",
  answer("8"),
  answer("14"),
  answer("1", correct = TRUE),
  answer("23"),
  allow_retry = TRUE
)
```
````

```{r letter-a-allow-retry, echo=FALSE}
question("What number is the letter A in the English alphabet?",
  answer("8"),
  answer("14"),
  answer("1", correct = TRUE),
  answer("23"),
  allow_retry = TRUE
)
```

-------------------


### Random Answer Order

If you want the answers to questions to be randomly arranged, you can add the `random_answer_order` option. For example:

````markdown
```{r letter-a-random-answer-order, echo=FALSE}`r ''`
question("What number is the letter A in the English alphabet?",
  answer("8"),
  answer("14"),
  answer("1", correct = TRUE),
  answer("23"),
  random_answer_order = TRUE
)
```
````

```{r letter-a-random-answer-order, echo=FALSE}
question("What number is the letter A in the English alphabet?",
  answer("8"),
  answer("14"),
  answer("1", correct = TRUE),
  answer("23"),
  random_answer_order = TRUE
)
```

-------------------

### Groups of Questions

You can present a group of related questions as a quiz by wrapping your questions within the `quiz` function. For example:

````markdown
```{r quiz1, echo=FALSE}`r ''`
quiz(caption = "Quiz 1",
  question("What number is the letter A in the *English* alphabet?",
    answer("8"),
    answer("14"),
    answer("1", correct = TRUE),
    answer("23")
  ),
  question("Where are you right now? (select ALL that apply)",
    answer("Planet Earth", correct = TRUE),
    answer("Pluto"),
    answer("At a computing device", correct = TRUE),
    answer("In the Milky Way", correct = TRUE),
    incorrect = "Incorrect. You're on Earth, in the Milky Way, at a computer."
  )
)
```
````


```{r quiz1, echo=FALSE}
quiz(caption = "Quiz 1",
  question("What number is the letter A in the *English* alphabet?",
    answer("8"),
    answer("14"),
    answer("1", correct = TRUE),
    answer("23")
  ),
  question("Where are you right now? (select ALL that apply)",
    answer("Planet Earth", correct = TRUE),
    answer("Pluto"),
    answer("At a computing device", correct = TRUE),
    answer("In the Milky Way", correct = TRUE),
    incorrect = "Incorrect. You're on Earth, in the Milky Way, at a computer."
  )
)
```


-------------------




## Basic Question Types

There are four basic types of quiz questions: radio button, checkbox, text box, and numeric.  Each one allows for one choice, multiple choices, and direct user text or numeric input respectively.



-------------------

### Radio

When wanting only one answer from a user, use a radio button question.  Even if multiple options are correct, the user is only able to pick a single value.

````markdown
```{r radio, echo = FALSE}`r ''`
question_radio(
  "Is this a good question?",
  answer("yes", correct = TRUE),
  answer("no", message = 'This is a good question.')
)
```
````

```{r radio, echo = FALSE}
question_radio(
  "Is this a good question?",
  answer("yes", correct = TRUE),
  answer("no", message = 'This is a good question.')
)
```


-------------------

### Checkbox

When wanting possibly **multiple** answers from a user, use a checkbox question.  All answers that are marked correct must be selected by the user to have the answer be correct.  A minimum of one correct answer is required.

````markdown
```{r checkbox, echo = FALSE}`r ''`
question_checkbox(
  "Select all the toppings that belong on a Margherita Pizza:",
  answer("tomato", correct = TRUE),
  answer("mozzarella", correct = TRUE),
  answer("basil", correct = TRUE),
  answer("extra virgin olive oil", correct = TRUE),
  answer("pepperoni", message = "Great topping! ... just not on a Margherita Pizza"),
  answer("onions"),
  answer("bacon"),
  answer("spinach"),
  random_answer_order = TRUE,
  allow_retry = TRUE,
  try_again = "Be sure to select all toppings!"
)
```
````

```{r checkbox, echo = FALSE}
question_checkbox(
  "Select all the toppings that belong on a Margherita Pizza:",
  answer("tomato", correct = TRUE),
  answer("mozzarella", correct = TRUE),
  answer("basil", correct = TRUE),
  answer("extra virgin olive oil", correct = TRUE),
  answer("pepperoni", message = "Great topping! ... just not on a Margherita Pizza"),
  answer("onions"),
  answer("bacon"),
  answer("spinach"),
  random_answer_order = TRUE,
  allow_retry = TRUE,
  try_again = "Be sure to select all toppings!"
)
```

-------------------

### Text box

If you'd like users to submit open-ended answers, use a text box question.  Correct and incorrect answers will be matched exactly (including white space). A minimum of one correct answer is required.

Text value inputs are trimmed before they are compared to answers provided.

````markdown
```{r text_box, echo = FALSE}`r ''`
question_text(
  "Please enter the word 'C0rrect' below:",
  answer("correct", message = "Don't forget to capitalize"),
  answer("c0rrect", message = "Don't forget to capitalize"),
  answer("Correct", message = "Is it really an 'o'?"),
  answer("C0rrect", correct = TRUE),
  allow_retry = TRUE
)
```
````

```{r text_box, echo = FALSE}
question_text(
  "Please enter the word 'C0rrect' below:",
  answer("correct", message = "Don't forget to capitalize"),
  answer("c0rrect", message = "Don't forget to capitalize"),
  answer("Correct", message = "Is it really an 'o'?"),
  answer("C0rrect", correct = TRUE),
  allow_retry = TRUE
)
```


-------------------

### Numeric

If you'd like users to supply numeric answers, use `question_numeric()`. A minimum of one correct answer is required. 

You can provide an initial `value` and a `step` size for the numeric input. Note that the `step` size only affects the numeric input when the up/down arrows are used to increment/decrement the number; users can still manually enter numbers that don't follow the `step` size.

Use `min` and `max` to set the minimum and maximum values. If a user submits a value outside of the min/max bounds, the feedback message will reveal the lower or upper bound.

````markdown
```{r numeric, echo = FALSE}`r ''`
question_numeric(
 "What is pi rounded to 2 digits?",
 answer(3, message = "Don't forget to use the digits argument"),
 answer(3.1, message = "Too few digits"),
 answer(3.142, message = "Too many digits"),
 answer(3.14, correct = TRUE),
 allow_retry = TRUE,
 min = 3,
 max = 4,
 step = 0.01
)
```
````

```{r numeric, echo = FALSE}
question_numeric(
 "What is pi rounded to 2 digits?",
 answer(3, message = "Don't forget to use the digits argument"),
 answer(3.1, message = "Too few digits"),
 answer(3.142, message = "Too many digits"),
 answer(3.14, correct = TRUE),
 allow_retry = TRUE,
 min = 3,
 max = 4,
 step = 0.01
)
```

-------------------

### Extra Arguments

All the the arguments described below are also accepted by `question_radio`, `question_checkbox`, `question_rank`, and the general `question` methods.

* Messages
  * `correct`: Message to be displayed when a user gets a correct answer.
  * `incorrect`: Message to be displayed when a user gets an incorrect answer and is not able to try again.
  * `try_again`: Message to be displayed when a user gets an incorrect answer and has the ability to try again.
  * `message`: An additional, neutral message to be displayed along with the correct/incorrect message.
  * `post_message`: Additional message to display along with correct/incorrect feedback.  If `allow_retry` is `TRUE`, this message will only be displayed after the correct submission.  If `allow_retry` is `FALSE`, it will produce a second message alongside the `message` value.
* Question Setup
  * `allow_retry`: Boolean that determines if the user should get a second chance at submitting their answer
  * `random_answer_order`: Boolean that determines if the question answers are displayed in a random order
* Buttons
  * `submit_button`: Label of the submit button
  * `try_again_button`: Label of the submit button
* Extra
  * `options`: List of extra pieces of information to store.  For an example, `question_text` uses `options` to store the `trim` and `placeholder` values.

Example:

````markdown
```{r options, echo = FALSE}`r ''`
question(
  "How many parameters are supplied in this question?",
  answer("1", message = "Really?"),
  answer("2"),
  answer("3"),
  answer("15", correct = TRUE, message = "Custom message here."),
  type = "learnr_text", # radio
  correct = "Question is correct!",
  try_again = "Try Again!",
  message = "Reminder to do something after answering the question...",
  post_message = "Message to be displayed after the correct answer is found",
  submit_button = "Submit Answer Here!",
  try_again_button = "Try Again Here!",
  allow_retry = TRUE,
  random_answer_order = TRUE,
  options = list(
    placeholder = "The answer is '15'",
    trim = TRUE
  )
)
```
````

```{r options, echo = FALSE}
question(
  "How many parameters are supplied in this question?",
  answer("1", message = "Really?"),
  answer("2"),
  answer("3"),
  answer("15", correct = TRUE, message = "Custom message here."),
  type = "learnr_text", # radio
  correct = "Question is correct!",
  try_again = "Try Again!",
  message = "Reminder to do something after answering the question...",
  post_message = "Message to be displayed after the correct answer is found",
  submit_button = "Submit Answer Here!",
  try_again_button = "Try Again Here!",
  allow_retry = TRUE,
  random_answer_order = TRUE,
  options = list(
    placeholder = "The answer is '15'",
    trim = TRUE
  )
)
```


-------------------



## Custom Question Types

`learnr` comes with four built in question types explained in [Basic Question Types](#section-basic-question-types): `question_radio`, `question_checkbox`, `question_text`, and `question_numeric`. Similar to `ggplot2` not being able to implement every possible geom, `learnr` cannot implement every possible `question` type.

To address this, `learnr` utilizes five generic [S3 methods](http://adv-r.had.co.nz/S3.html) to define the behavior of a custom tutorial question.  Each generic [S3 method](http://adv-r.had.co.nz/S3.html) should correspond to one of `type` values supplied to the question.

* `question_ui_initialize.TYPE(question, value, ...)` (**required**)
  * Determines how the question is initially displayed to the users. This should return an object that can be displayed using [`shiny::renderUI`](https://shiny.rstudio.com/reference/shiny/latest/renderUI.html).  This method will be re-executed if the question is attempted again.  The `value` will contain a known starting value for continuity between attempts.
* `question_ui_try_again.TYPE(question, value, ...)`
  * Determines how the question is displayed to the users after they answer the question incorrectly and are allowed multiple attempts. This function should return an object that can be displayed using [`shiny::renderUI`](https://shiny.rstudio.com/reference/shiny/latest/renderUI.html).  The `value` will contain the currently submitted answer. This defaults to a disabled `question_ui_initialize.TYPE` output.
* `question_ui_completed.TYPE(question, value, ...)`
  * Determines how the question is displayed after a correct answer or an incorrect answer that cannot be attempted again.  This should return an object that can be displayed using [`shiny::renderUI`](https://shiny.rstudio.com/reference/shiny/latest/renderUI.html). This defaults to a disabled `question_ui_initialize.TYPE` output.
* `question_is_valid.TYPE(question, value, ...)`
  * This method should return a boolean that determines if the input answer is valid.  Depending on the value, this function enables and disables the submission button.  This defaults to check if the answer value is not `NULL`.
* `question_is_correct.TYPE(question, value, ...)` (**required**)
  * This method determines if the input answer is correct.  This function's return value should be the output of `learnr::correct`, `learnr::incorrect`, or `learnr::mark_as`.

If a vector of types is supplied to a question's `type`, the S3 methods will be dispatched starting with the first type value and ending with the last type value. For example, let us define a new question type that should behave like a learnr checkbox question, but have a special implementation of `question_is_correct` where the answer is always correct.

````markdown
```{r custom_class, echo = FALSE}`r ''`
question_is_correct.always_correct <- function(question, value, ...) {
  learnr::mark_as(TRUE, messages = NULL)
}

registerS3method("question_is_correct", "always_correct", question_is_correct.always_correct)

ques <- question(
  "Custom Method",
  answer("answer", correct = TRUE),
  answer("also marked as correct", correct = FALSE),
  type = c("always_correct", "learnr_checkbox")
)
```
````

```{r custom_class, echo = FALSE}
question_is_correct.always_correct <- function(question, value, ...) {
  learnr::mark_as(TRUE, messages = NULL)
}

registerS3method("question_is_correct", "always_correct", question_is_correct.always_correct)

ques <- question(
  "Custom Method",
  answer("answer", correct = TRUE),
  answer("also marked as correct", correct = FALSE),
  type = c("always_correct", "learnr_checkbox")
)
ques
```

When the question, `ques`, above is initialized, `question_ui_initialize` will dispatch on `question_ui_initialize.always_correct`.  Since no method has been defined, `question_ui_initialize.learnr_checkbox` will be called.  However, when `question_is_correct` is called, `question_is_correct.always_correct` is found and called.

Supplying multiple type values allows for clean abstraction between objects that share common functionality.


### [`sortable`](https://rstudio.github.io/sortable/)

[`sortable`](https://rstudio.github.io/sortable/), an htmlwidget wrapper to [SortableJS](https://sortablejs.github.io/Sortable/) (a "JavaScript library for reorderable drag-and-drop lists."), as implemented a custom question type: `question_rank`.  The convention of naming the new question method as `question_METHOD` will help users find your newly defined question function by namespacing it with `question_`.

`sortable` defined it's ranking question as `question_rank`.  It uses the `options` parameter to pass along the output of `sortable_options`, which are specific to the SortableJS library. By naming the type `"sortable_rank"`, the type is namespaced by the package while still including a sub type.  By making a wrapper function, different default `question` parameters can be implemented, such as setting `random_answer_order` to be `TRUE`.

```{r sortable_example, eval = FALSE}
question_rank <- function(..., random_answer_order = TRUE, options = sortable::sortable_options()) {
  learnr::question(
    ...,
    random_answer_order = random_answer_order,
    type = "sortable_rank",
    options = options
  )
}
```

````markdown
```{r sortable_question, echo = FALSE}`r ''`
rank_ex <- sortable::question_rank(
  "Sort the first 5 letters",
  learnr::answer(LETTERS[1:5], correct = TRUE),
  learnr::answer(rev(LETTERS[1:5]), correct = FALSE, "Other direction!")
)
rank_ex
```
````

```{r sortable_question, echo = FALSE}
rank_ex <- sortable::question_rank(
  "Sort the first 5 letters",
  learnr::answer(LETTERS[1:5], correct = TRUE),
  learnr::answer(rev(LETTERS[1:5]), correct = FALSE, "Other direction!")
)
rank_ex
```

In the code sections below, we will walk through each method and a final helper method to create a `sortable_rank` tutorial question.

#### `question_ui_initialize.sortable_rank`

`question_ui_initialize()` is called when the question is first initialized and after a user wants to try again.

The code below extracts the necessary information to create a Shiny UI object, using the the `question$ids$answer` value and labels from the first answer.  Using the `learnr::question` `options` parameter, we can pass options directly to the `sortable::sortable_js` function.

```{r sortable_init, eval = FALSE}
question_ui_initialize.sortable_rank <- function(question, value, ...) {

  if (!is.null(value)) {
    # if an answer exists already, it should be displayed as is
    labels <- value
  } else {
    # get the first answer
    labels <- question$answers[[1]]$option

    # if we should randomize the order
    if (
      isTRUE(question$random_answer_order)
    ) {
      # shuffle the options
      labels <- sample(labels, length(labels))
    }
  }

  # return the sortable htmlwidget
  sortable::rank_list(
    text = question$question,
    input_id = question$ids$answer,
    labels = labels,
    options = question$options
  )
}
```

Example:

```{r ui-ex}
# initial state with no initial value
question_ui_initialize(rank_ex, value = NULL)
```


#### `question_ui_completed.sortable_rank`

`question_ui_completed()` is called when the question is finished and cannot be tried again.

The code below adds an extra `options` value to disable SortableJS.  Like `question_ui_initialize`, it also returns a Shiny UI object.

```{r sortable_complete, eval = FALSE}
question_ui_completed.sortable_rank <- function(question, value, ...) {
  question$options <- modifyList(
    question$options,
    # forcefully add an extra option to disable sortable.js
    sortable::sortable_options(disabled = TRUE)
  )
  # disable all html tags
  learnr::disable_all_tags(
    # display just like init, with current answer
    learnr::question_ui_initialize(question, value, ...)
  )
}
```

Example:

```{r ex-completed}
# completed state with display value set to C, A, D, E, B
question_ui_completed(rank_ex, value = c("C", "A", "D", "E", "B"))
```

#### `question_ui_try_again.sortable_rank`

The `sortable` package chose to have the "Try Again" state be defined the same as the "Completed" state.

```{r sortable_try_again, eval = FALSE}
question_ui_try_again.sortable_rank <- question_ui_completed.sortable_rank
```



#### `question_is_valid.sortable_rank`

`question_is_valid()` is called to determine if the submit button should be clickable.

The default value of `!is.null(value)` will work for the `sortable` question.  Therefore, no implementation is needed.


#### `question_is_correct.sortable_rank`

`question_is_correct()` is called to determine if the answer submitted is correct.  This method is required and it may be helpful to use the `options` supplied to a `question` to change how an answer is found to be correct.

Since sortable is comparing a character vector to possible answer character vectors, a quick `identical` check through each answer will be enough for this method.

The return value from `question_is_correct` should return output from `mark_as`.  This allows for extra messages to be displayed while determining if the answer is correct / incorrect.

```{r sortable_correct, eval = FALSE}
question_is_correct.sortable_rank <- function(question, value, ...) {
  # for each possible answer, check if it matches
  for (answer in question$answers) {
    if (identical(answer$option, value)) {
      # if it matches, return the correct-ness and its message
      return(learnr::mark_as(answer$is_correct, answer$message))
    }
  }
  # no match found. mark as incorrect
  return(learnr::mark_as(FALSE, NULL))
}
```

Example:

```{r ex-is-correct}
# with incorrect values
question_is_correct(rank_ex, value = c("E", "D", "C", "B", "A"))

# with correct values
question_is_correct(rank_ex, value = c("A", "B", "C", "D", "E"))
```
