#' Score a package metric
#'
#' Convert a package metric into a numeric value between 0 to 1
#'
#' @param x A \code{pkg_metric_*} class object to score
#' @param ... Additional arguments unused
#'
#' @return score of a package risk metric
#' @export
#'
metric_score <- function(x, ...) {
if (inherits(x, "pkg_metric_condition"))
return(metric_score_condition(x, ...))
UseMethod("metric_score")
}
#' @export
metric_score.default <- function(x, ...) {
if (!inherits(x, "pkg_metric")) {
warning(sprintf(paste0(
"Don't know how to score object of class %s. score is only intended ",
"to be used with objects inheriting class 'pkg_metric', ",
"returning default score of 0."),
paste0('"', class(x), '"', collapse = ", ")))
} else {
warning(sprintf(paste0(
"no available scoring algorithm for metric of class %s, ",
"returning default score of 0."),
paste0('"', class(x)[1], '"')))
}
0L
}
metric_score_condition <- function(x, ...) {
UseMethod("metric_score_condition")
}
metric_score_condition.pkg_metric_error <- function(x, ...,
error_handler = score_error_default) {
error_handler(x, ...)
}
metric_score_condition.pkg_metric_na <- function(x, ...) {
structure(NA_real_, class = c("pkg_score_na", "numeric"))
}
metric_score_condition.pkg_metric_error <- function(x, ...) {
structure(NA_real_, class = c("pkg_score_error", "numeric"))
}
metric_score_condition.pkg_metric_todo <- function(x, ...) {
structure(NA_real_, class = c("pkg_score_todo", "numeric"))
}
#' Default score error handling, emitting a warning and returning 0
#'
#' @inheritParams metric_score
#' @return a value of package score
#' @export
score_error_default <- metric_score.default
#' Score error handler to silently return 0
#'
#' @inheritParams metric_score
#'
#' @return a value of package score
#' @export
score_error_zero <- function(...) 0
#' Score error handler to silently return NA
#'
#' @inheritParams metric_score
#' @return a value of package score
#' @export
score_error_NA <- function(...) NA_real_
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.