feat: add RMSE

Author: atsyplenkov

NAMESPACE

@@ -6,20 +6,23 @@ S3method(nse, data.frame)
 S3method(kge, data.frame)
 S3method(kge2012, data.frame)
 S3method(mse, data.frame)
+S3method(rmse, data.frame)
 S3method(pbias, data.frame)
 S3method(press, data.frame)
 S3method(sfe, data.frame)
 export(nse)
 export(kge)
 export(kge2012)
 export(mse)
+export(rmse)
 export(pbias)
 export(press)
 export(sfe)
 export(nse_vec)
 export(kge_vec)
 export(kge2012_vec)
 export(mse_vec)
+export(rmse_vec)
 export(pbias_vec)
 export(press_vec)
 export(sfe_vec)

NEWS.md

@@ -1,5 +1,12 @@
 # tidyhydro (development version)
 
+## New features
+-   Added RMSE
+
+## Miscellaneous
+
+-   Added structure. Functions are now groupped into two categories: regression and GOF
+
 # tidyhydro 0.1.1
 
 ## New features
@@ -13,6 +20,7 @@
 -   Removed unicode characters α, β
 
 ## Miscellaneous
+
 -   Created website with vignettes (https://atsyplenkov.github.io/tidyhydro)
 
 # tidyhydro 0.1.0

R/RcppExports.R

@@ -5,8 +5,8 @@ kge_cpp <- function(obs, sim, na_rm = TRUE, version = "2012") {
     .Call(`_tidyhydro_kge_cpp`, obs, sim, na_rm, version)
 }
 
-mse_cpp <- function(truth, estimate, na_rm = TRUE) {
-    .Call(`_tidyhydro_mse_cpp`, truth, estimate, na_rm)
+mse_cpp <- function(truth, estimate, na_rm = TRUE, sqrt = TRUE) {
+    .Call(`_tidyhydro_mse_cpp`, truth, estimate, na_rm, sqrt)
 }
 
 nse_cpp <- function(truth, estimate, performance = FALSE, na_rm = TRUE) {

R/mse.R

@@ -96,5 +96,88 @@ mse_vec <- function(
 ) {
   yardstick::check_numeric_metric(truth, estimate, case_weights = NULL)
 
-  mse_cpp(truth, estimate, na_rm = na_rm)
+  mse_cpp(truth, estimate, na_rm = na_rm, sqrt = FALSE)
+}
+
+#' Root Mean Squared Error (RMSE)
+#' @keywords gof
+#'
+#' @details
+#' The RMSE is estimated as follows:
+#' \deqn{
+#' RMSE = \sqrt{\frac{1}{n} \sum_{i=1}^{n}{(sim_i - obs_i)^2}}
+#' }
+#' where:
+#' \itemize{
+#'   \item \eqn{sim} defines model simulations at time step \eqn{i}
+#'   \item \eqn{obs} defines model observations at time step \eqn{i}
+#' }
+#'
+#' @family numeric metrics
+#' @family accuracy metrics
+#' @templateVar fn rmse
+#' @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 estimate The column identifier for the predicted
+#' results (that is also `numeric`). As with `truth` this can be
+#' specified different ways but the primary method is to use an
+#' unquoted variable name. 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-numeric
+#'
+#' @export
+#'
+rmse <- function(data, ...) {
+  UseMethod("rmse")
+}
+
+rmse <- yardstick::new_numeric_metric(
+  rmse,
+  direction = "minimize"
+)
+
+#' @rdname rmse
+#' @export
+rmse.data.frame <- function(
+  data,
+  truth,
+  estimate,
+  na_rm = TRUE,
+  ...
+) {
+  yardstick::numeric_metric_summarizer(
+    name = "rmse",
+    fn = rmse_vec,
+    data = data,
+    truth = !!rlang::enquo(truth),
+    estimate = !!rlang::enquo(estimate),
+    na_rm = na_rm
+  )
+}
+
+#' @rdname rmse
+#' @export
+rmse_vec <- function(
+  truth,
+  estimate,
+  na_rm = TRUE,
+  ...
+) {
+  yardstick::check_numeric_metric(truth, estimate, case_weights = NULL)
+
+  mse_cpp(truth, estimate, na_rm = na_rm, sqrt = TRUE)
 }