Give better hint for checkbox questions created with question() in try_again message

NEWS.md

@@ -1,6 +1,7 @@
 # learnr (development version)
 
 -   Moved curl from Imports to Suggests. curl is only required when using an external evaluator (#776).
+-   The default `try_again` message for checkbox questions now prompts the student to "select every correct answer" regardless of whether the question was created by `qustion()` or `question_checkbox()` (#783).
 
 # learnr 0.11.3
 

R/question_checkbox.R

@@ -42,6 +42,9 @@
 #' )
 #'
 #' @inheritParams question
+#' @param try_again Text to print for an incorrect answer
+#'   (defaults to "Incorrect. Be sure to select every correct answer.")
+#'   when `allow_retry` is `TRUE`.
 #' @param ... Answers created with [answer()] or [answer_fn()], or extra
 #'   parameters passed onto [question()]. Function answers do not
 #'   appear in the checklist, but are checked first in the order they are

R/question_numeric.R

@@ -27,6 +27,8 @@
 #'   step = 1
 #' )
 #'
+#' @param try_again Text to print for an incorrect answer (defaults to
+#'   "Incorrect") when `allow_retry` is `TRUE`.
 #' @param tolerance Submitted values within an absolute difference less than or
 #'   equal to `tolerance` will be considered equal to the answer value. Note
 #'   that this tolerance is for all [answer()] values. For more specific answer

R/question_radio.R

@@ -16,6 +16,8 @@
 #' )
 #'
 #' @inheritParams question
+#' @param try_again Text to print for an incorrect answer (defaults to
+#'   "Incorrect") when `allow_retry` is `TRUE`.
 #' @param ... Answers created with [answer()] or extra parameters passed onto
 #'   [question()]. Function answers are ignored for radio questions because the
 #'   user is required to select a single answer.

R/question_text.R

@@ -37,6 +37,8 @@
 #'   }, label = "fizz or buzz")
 #' )
 #'
+#' @param try_again Text to print for an incorrect answer (defaults to
+#'   "Incorrect") when `allow_retry` is `TRUE`.
 #' @param rows,cols Defines the size of the text input area in terms of the
 #'   number of rows or character columns visible to the user. If either `rows`
 #'   or `cols` are provided, the quiz input will use [shiny::textAreaInput()]

R/quiz.R

@@ -59,14 +59,16 @@
 #'   even though multiple correct answers are specified that inputs which
 #'   include only one correct answer are still correct. Pass `"checkbox"` to
 #'   force the use of checkboxes (as opposed to radio buttons) even though only
-#'   once correct answer was provided.
+#'   one correct answer was provided.
 #' @param correct For `question`, text to print for a correct answer (defaults
 #'   to "Correct!"). For `answer`, a boolean indicating whether this answer is
 #'   correct.
 #' @param incorrect Text to print for an incorrect answer (defaults to
 #'   "Incorrect") when `allow_retry` is `FALSE`.
-#' @param try_again Text to print for an incorrect answer (defaults to
-#'   "Incorrect") when `allow_retry` is `TRUE`.
+#' @param try_again Text to print for an incorrect answer when `allow_retry`
+#'   is `TRUE`.
+#'   Defaults to "Incorrect. Be sure to select every correct answer." for
+#'   checkbox questions and "Incorrect" for non-checkbox questions.
 #' @param message Additional message to display along with correct/incorrect
 #'   feedback. This message is always displayed after a question submission.
 #' @param post_message Additional message to display along with
@@ -135,7 +137,7 @@ question <- function(
     type = c("auto", "single", "multiple", "learnr_radio", "learnr_checkbox", "learnr_text", "learnr_numeric"),
     correct = "Correct!",
     incorrect = "Incorrect",
-    try_again = incorrect,
+    try_again = NULL,
     message = NULL,
     post_message = NULL,
     loading = NULL,
@@ -185,6 +187,13 @@ question <- function(
       type
     )
   }
+  if (is.null(try_again)) {
+    try_again <- if (identical(type, "learnr_checkbox")) {
+      "Incorrect. Be sure to select every correct answer."
+    } else {
+      incorrect
+    }
+  }
 
   # ensure we have at least one correct answer, if required
   must_have_correct <- identical(type, "learnr_radio") || is.null(answers_split[["function"]])

tests/testthat/test-question_checkbox.R

@@ -35,6 +35,37 @@ test_that("question_checkbox() does not include correct messages for incorrect a
   expect_marked_as(question_is_correct(q, "F"), correct = FALSE)
 })
 
+test_that("question_checkbox() message depends on whether allow_retry = TRUE", {
+
+  incorrect_message <- "incorrect"
+  try_again_message <- "try_again"
+
+  q <- question_checkbox(
+    "test",
+    answer("A", correct = TRUE),
+    answer("B", correct = TRUE),
+    answer("C", correct = FALSE),
+    incorrect = incorrect_message,
+    try_again = try_again_message
+  )
+
+  out_no_retry <- question_messages(
+    question = q,
+    messages = NULL,
+    is_correct = FALSE,
+    is_done = TRUE
+  )
+  expect_equal(as.character(out_no_retry[[1]]$children[[1]]), incorrect_message)
+
+  out_retry <- question_messages(
+    question = q,
+    messages = NULL,
+    is_correct = FALSE,
+    is_done = FALSE
+  )
+  expect_equal(as.character(out_retry[[1]]$children[[1]]), try_again_message)
+})
+
 test_that("question_checkbox() evaluates function answers first", {
   q <- question_checkbox(
     "test",

tests/testthat/test-quiz.R

@@ -129,3 +129,42 @@ test_that("loading placeholder is correctly generated for HTML question texts",
     )
   )
 })
+
+test_that("question() message depends on whether type is checkbox", {
+
+  q_radio <- question(
+    "test",
+    answer("A", correct = TRUE),
+    answer("B", correct = FALSE),
+    answer("C", correct = FALSE)
+  )
+
+  out_radio <- question_messages(
+    question = q_radio,
+    messages = NULL,
+    is_correct = FALSE,
+    is_done = FALSE
+  )
+  expect_equal(
+    as.character(out_radio[[1]]$children[[1]]),
+    "Incorrect"
+  )
+
+  q_checkbox <- question(
+    "test",
+    answer("A", correct = TRUE),
+    answer("B", correct = TRUE),
+    answer("C", correct = FALSE)
+  )
+
+  out_checkbox <- question_messages(
+    question = q_checkbox,
+    messages = NULL,
+    is_correct = FALSE,
+    is_done = FALSE
+  )
+  expect_equal(
+    as.character(out_checkbox[[1]]$children[[1]]),
+    "Incorrect. Be sure to select every correct answer."
+  )
+})