#' Evaluates a condition
#'
#' @description
#' `r lifecycle::badge("superseded")` Please use [grade_this()] mixed with
#' [pass()], [pass_if_equal()], [fail()], and/or [fail_if_equal()]. Can also use
#' [eval_gradethis()].
#'
#' Evaluates the [condition()] object to return a [graded()] value.
#'
#' @examples
#' condi_formula_t <- condition(
#' ~ identical(.result, 5),
#' message = "my correct message",
#' correct = TRUE
#' )
#' evaluate_condition(
#' condi_formula_t,
#' last_value = 5,
#' env = new.env()
#' )
#' @param condition a [condition()] object
#' @param env environment to evaluate the condition
#' @param ... ignored
#' @inheritParams gradethis_exercise_checker
#'
#' @return a [graded()] value if `condi$x` is `TRUE` or `NULL` if `condi$x` is
#' `FALSE`
#' @keywords internal
#' @export
evaluate_condition <- function(condition, ..., last_value, env) {
checkmate::assert_class(condition, "gradethis_condition")
ellipsis::check_dots_empty()
err_msg <- NULL
res <- tryCatch(
{
switch(
condition$type,
"formula" = evaluate_condi_formula(
condition$x,
last_value,
env = env
),
"function" = evaluate_condi_function(condition$x, last_value),
"value" = evaluate_condi_value(condition$x, last_value)
)
},
error = function(e) {
err_msg <<- conditionMessage(e)
}
)
if (!is.null(err_msg)) {
return(legacy_graded(correct = FALSE, message = err_msg))
}
# if we compare something like a vector or dataframes to one another
# we need to collapse the result down to a single logical value
if (length(res) > 1) {
## this isn't the best way to handle NA values so we raise a warning.
## https://github.com/rstudio-education/grader/issues/46 # nolint
warning(glue::glue("I got a length of {length(res)}, instead of 1 during the conditional check.\n Did you use == ? If so, consider using identical()")) # nolint
res <- !all(is.na(res)) && all(res, na.rm = TRUE)
}
# implement when we add a `exec`/`expect` api to grade_result
# will account for function returns
# if (inherits(res, 'gradethis_graded')) {return(res)} # nolint
if (is.null(res)) return(NULL)
checkmate::assert_logical(res, len = 1, null.ok = FALSE)
if (res) {
legacy_graded(correct = condition$correct, message = condition$message)
} else {
NULL
}
}
evaluate_condi_formula <- function(formula, user_answer, env) {
rlang::eval_tidy(
formula[[2]],
data = list(.result = user_answer, . = user_answer),
env = env
)
}
evaluate_condi_function <- function(fxn, user_answer) {
fxn(user_answer)
}
evaluate_condi_value <- function(val, user_answer) {
identical(val, user_answer)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.