R/problem_grade.R

Defines functions problem_grade.tblcheck_problem problem_grade.gradethis_problem problem_grade.list problem_grade.default problem_grade

Documented in problem_grade problem_grade.default problem_grade.gradethis_problem problem_grade.list problem_grade.tblcheck_problem

#' Apply automatic grading to a problem object
#'
#' Automatically converts a [problem()] object into a \pkg{gradethis} grade.
#' `problem_grade()` is an S4 generic and \pkg{tblcheck} provides an internal
#' method for problems with class `"tblcheck_problem"`. In \pkg{tblcheck}, or
#' for problems with this class, any problems are automatically turned into
#' failing grades with [gradethis::fail()] and using the message provided by
#' [problem_message()].
#'
#' @examples
#' .result <- 1:10
#' .solution <- letters[1:10]
#' problem <- vec_check()
#' problem_grade(problem)
#'
#' @param problem A problem generated by [tbl_check()], [vec_check()] or their
#'   related helper functions.
#' @inheritParams tbl_check
#' @param env The environment used for grading.
#' @inheritDotParams gradethis::fail -message
#'
#' @return A [gradethis::fail()] message or `NULL` invisibly.
#'
#' @family Problem functions
#' @export
problem_grade <- function(problem, max_diffs = 3, env = parent.frame(), ...) {
	UseMethod("problem_grade")
}

#' @rdname problem_grade
#' @export
problem_grade.default <- function(
	problem, max_diffs = 3, env = parent.frame(), ...
) {
	invisible()
}

#' @rdname problem_grade
#' @export
problem_grade.list <- function(
	problem, max_diffs = 3, env = parent.frame(), ...
) {
	problem <- as_problem(problem)
	problem_grade(problem, max_diffs = max_diffs, env = env, ...)
}

#' @rdname problem_grade
#' @export
problem_grade.gradethis_problem <- function(
	problem, max_diffs = 3, env = parent.frame(), ...
) {
	if (is.null(problem)) {
		return(invisible())
	}

	err <- catch_internal_problem(
		checkmate::assert_number(max_diffs, lower = 1),
		call = find_tblcheck_call()
	)

	if (is_problem(err)) {
		return(problem_grade(err))
	}

	gradethis::fail(
		problem_message(problem, max_diffs = max_diffs),
		problem = problem,
		env = env,
		...
	)
}

#' @rdname problem_grade
#' @export
problem_grade.tblcheck_problem <- function(
	problem, max_diffs = 3, env = parent.frame(), ...
) {
	NextMethod()
}
rstudio/tblcheck documentation built on March 11, 2023, 5:42 p.m.