#' Grade student code against a solution
#'
#' @description
#' `grade_this_code()` compares student code to a solution (i.e. model code) and
#' describes the first way in which the student code differs. If the student
#' code exactly matches the solution, `grade_this_code()` returns a customizable
#' success message (`correct`). If the student code does not match the solution,
#' a customizable incorrect message (`incorrect`) can also be provided.
#'
#' In most cases, to use `grade_this_code()`, ensure that your exercise has a
#' `-solution` chunk:
#'
#' ````
#' ```{r example-solution}
#' sqrt(log(1))
#' ```
#' ````
#'
#' Then, call `grade_this_code()` in your exercise's `-check` or `-code-check` chunk:
#'
#' ````
#' ```{r example-check}
#' grade_this_code()
#' ```
#' ````
#'
#' If `grade_this_code()` is called in a `-code-check` chunk and returns
#' feedback, either passing or failing feedback, then the user's code is not
#' executed. If you want the user to see the output of their code, call
#' `grade_this_code()` in the `-check` chunk. You can also use
#' `grade_this_code()` as a pre-check to avoid running code when it fails or
#' passes by calling `grade_this_code()` inside the `-code-check` chunk and
#' setting `action = "pass"` or `action = "fail"` to only return feedback when
#' the user's code passes or fails, respectively. (Note: requires \pkg{learnr}
#' version 0.10.1.9017 or later.)
#'
#' Learn more about how to use `grade_this_code()` in the **Details** section
#' below.
#'
#' @section Details:
#'
#' `grade_this_code()` only inspects for code differences between the
#' student's code and the solution code. The final result of the student code
#' and solution code is ignored. See the **Code differences** section of
#' [code_feedback()] for implementation details on how code is determined to
#' be different.
#'
#' You can call `grade_this_code()` in two ways:
#'
#' 1. If you want to check the student's code without evaluating it, call
#' `grade_this_code()` in the `*-code-check` chunk.
#'
#' 1. To return grading feedback in along with the resulting output of the
#' student's code, call `grade_this_code()` in the `*-check` chunk of the
#' exercise.
#'
#' To provide the solution code, include a `*-solution` code chunk in the
#' learnr document for the exercise to be checked. When used in this way,
#' `grade_this_code()` will automatically find and use the student's
#' submitted code — `.user_code` in [grade_this()] — as well as the solution
#' code — `.solution_code` in [grade_this()].
#'
#' @section Custom messages:
#'
#' You can customize the `correct` and `incorrect` messages shown to the user
#' by `grade_this_code()`. Both arguments accept template strings that are
#' processed by [glue::glue()]. If you provide a custom template string, it
#' completely overwrites the default string, but you can include the
#' components used by the default message by adding them to your custom
#' message.
#'
#' There are four helper functions used in the default messages that you may
#' want to include in your custom messages. To use the output of any of the
#' following, include them inside braces in the template string. For example
#' use `{code_feedback()}` to add the code feedback to your custom `incorrect`
#' message.
#'
#' 1. [code_feedback()]: Adds feedback about the first observed difference
#' between the student's submitted code and the model solution code.
#' If you want to grade the student's code without providing feedback,
#' leave [code_feedback()] out of your string.
#'
#' 2. [pipe_warning()]: Informs the user that their code was unpiped prior to
#' comparison. This message is included by default to help clarify cases
#' when the code feedback makes more sense in the unpiped context.
#'
#' 3. [random_praise()] and [random_encouragement()]: These praising and
#' encouraging messages are included by default in correct and incorrect
#' grades, by default.
#'
#' @examples
#' # For an interactive example run: gradethis_demo()
#'
#' # # These are manual examples, see grading demo for `learnr` tutorial usage
#'
#' grade_this_code()(
#' mock_this_exercise(
#' .user_code = "sqrt(log(2))", # user submitted code
#' .solution_code = "sqrt(log(1))" # from -solution chunk
#' )
#' )
#'
#' grade_this_code()(
#' mock_this_exercise(
#' # user submitted code
#' .user_code = "runif(1, 0, 10)",
#' # from -solution chunk
#' .solution_code = "runif(n = 1, min = 0, max = 1)"
#' )
#' )
#'
#' # By default, grade_this_code() informs the user that piped code is unpiped
#' # when comparing to the solution
#' grade_this_code()(
#' mock_this_exercise(
#' # user submitted code
#' .user_code = "storms %>% select(year, month, hour)",
#' # from -solution chunk
#' .solution_code = "storms %>% select(year, month, day)"
#' )
#' )
#'
#' # By setting `correct` or `incorrect` you can change the default message
#' grade_this_code(
#' correct = "Good work!",
#' incorrect = "Not quite. {code_feedback()} {random_encouragement()}"
#' )(
#' mock_this_exercise(
#' # user submitted code
#' .user_code = "storms %>% select(year, month, hour)",
#' # from -solution chunk
#' .solution_code = "storms %>% select(year, month, day)"
#' )
#' )
#'
#' @param correct A `glue`-able character string to display if the student
#' answer matches a known correct answer.
#' @param incorrect A `glue`-able character string to display if the student
#' answer does not match the known correct answer. Use `code_feedback()` in
#' this string to control the placement of the auto-generated feedback message
#' produced by comparing the student's submission with the solution.
#' Use a string that doesn't include `code_feedback()` to grade the student's
#' code without providing feedback.
#' @param ... Ignored
#' @param action The action to take:
#'
#' 1. `"pass"` provide passing `correct` feedback when the user's code
#' matches the solution code.
#' 2. `"fail"` provide failing `incorrect` feedback when the user's code does
#' not match the solution code.
#' 3. `"both"` always provide passing or failing feedback.
#' @inheritParams code_feedback
#'
#' @return Returns a function whose first parameter will be an environment
#' containing objects specific to the exercise and submission (see **Available
#' variables**). For local testing, you can create a version of the expected
#' environment for a mock exercise submission with [mock_this_exercise()].
#' Calling the returned function on the exercise-checking environment will
#' evaluate the grade-checking `expr` and return a final grade via [graded()].
#'
#' @seealso [code_feedback()], [grade_this()], [mock_this_exercise()]
#' @export
grade_this_code <- function(
correct = getOption("gradethis.code_correct", getOption("gradethis.pass", "Correct!")),
incorrect = getOption("gradethis.code_incorrect", getOption("gradethis.fail", "Incorrect")),
...,
allow_partial_matching = getOption("gradethis.allow_partial_matching", TRUE),
action = c("both", "pass", "fail")
) {
ellipsis::check_dots_empty()
action <- tolower(action)
action <- match.arg(action)
if (identical(action, "both")) {
action <- c("pass", "fail")
}
# MUST wrap calling function to be able to shim in `.correct`/`.incorrect`
function(check_env) {
if (is_empty_code(check_env[[".user_code"]])) {
return(grade_code_is_empty())
}
check_env[[".__correct"]] <- correct
check_env[[".__incorrect"]] <- incorrect
check_env[[".__action"]] <- action
grade <- with_options(
list(
# Pass allow_partial_matching to internal code_feedback() calls
gradethis.allow_partial_matching = allow_partial_matching,
# The point of grade_this_code() is to return code feedback so we set
# maybe_code_feedback to TRUE in case the user calls maybe_code_feedback()
gradethis.maybe_code_feedback = TRUE
),
grade_this({
# check code for mistakes and store error feedback in .message so it
# can be found by glue in fail(). Will be NULL if code is correct.
.message <- code_feedback()
# call `pass`/`fail` inside `grade_this` to have access to `check_env`
# but need to use `get()` to avoid using `utils::globalVariables`
if (is.null(.message)) {
# no code_feedback() message means the code is correct
if ("pass" %in% get(".__action")) {
pass(get(".__correct"))
}
} else {
if ("fail" %in% get(".__action")) {
fail(get(".__incorrect"), hint = FALSE)
}
}
invisible(NULL)
})(check_env)
)
if (is.null(grade)) {
return(invisible(NULL))
}
class(grade) <- c("gradethis_graded_this_code", class(grade))
grade
}
}
is_empty_code <- function(code) {
length(code) == 0 || all(!nzchar(str_trim(code)))
}
grade_code_is_empty <- function() {
graded(
logical(),
"I didn't receive your code. Did you write any?",
type = "info"
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.