add cv

Author: atsyplenkov

NAMESPACE

@@ -9,6 +9,7 @@ S3method(mse, data.frame)
 S3method(rmse, data.frame)
 S3method(pbias, data.frame)
 S3method(press, data.frame)
+S3method(cv, data.frame)
 S3method(sfe, data.frame)
 export(nse)
 export(kge)
@@ -18,6 +19,7 @@ export(rmse)
 export(pbias)
 export(press)
 export(sfe)
+export(cv)
 export(nse_vec)
 export(kge_vec)
 export(kge2012_vec)
@@ -26,3 +28,4 @@ export(rmse_vec)
 export(pbias_vec)
 export(press_vec)
 export(sfe_vec)
+export(cv_vec)

R/variability.R

@@ -0,0 +1,72 @@
+#' Coefficient of Variation (Cv)
+#' @keywords summary
+#'
+#' @family numeric metrics
+#' @family accuracy metrics
+#' @templateVar fn cv
+#' @template return
+#'
+#' @param data A `data.frame` containing the columns specified by the `truth`
+#' and `estimate` arguments.
+#'
+#' @param truth The column identifier for the true results
+#' (that is `numeric`). This should be an unquoted column name although
+#' this argument is passed by expression and supports
+#' [quasiquotation][rlang::quasiquotation] (you can unquote column
+#' names). For `_vec()` functions, a `numeric` vector.
+#'
+#' @param na_rm A `logical` value indicating whether `NA`
+#' values should be stripped before the computation proceeds.
+#'
+#' @param ... Not currently used.
+#'
+#' @template examples-description
+#'
+#' @export
+#'
+
+cv <- function(data, ...) {
+  UseMethod("cv")
+}
+
+cv <- yardstick::new_numeric_metric(
+  cv,
+  direction = "minimize"
+)
+
+#' @rdname cv
+#' @export
+cv.data.frame <- function(
+  data,
+  truth,
+  na_rm = TRUE,
+  ...
+) {
+  yardstick::numeric_metric_summarizer(
+    name = "cv",
+    fn = cv_vec,
+    data = data,
+    truth = !!rlang::enquo(truth),
+    estimate = !!rlang::enquo(truth),
+    na_rm = na_rm
+  )
+}
+
+#' @rdname cv
+#' @export
+cv_vec <- function(
+  truth,
+  na_rm = TRUE,
+  ...
+) {
+  yardstick::check_numeric_metric(truth, truth, case_weights = NULL)
+
+  if (na_rm) {
+    truth <- truth[!is.na(truth)]
+  }
+
+  x0 <- mean(truth)
+  k <- truth / x0
+
+  sqrt(sum((k - 1)^2) / (length(truth) - 1))
+}

man-roxygen/examples-description.R

@@ -0,0 +1,9 @@
+#' @examples
+#' library(tidyhydro)
+#' data(avacha)
+#'
+#' # Supply truth and predictions as bare column names
+#' <%=fn %>(avacha, obs)
+#'
+#' # Or as numeric vectors
+#' <%=fn %>_vec(avacha$obs)