support more sample weights

Author: mb706

R/helper.R

@@ -23,6 +23,14 @@ wmean = function(x, w) { # a better stats::weighted.mean
   sum(x * (w / sum(w)))
 }
 
+wsum = function(x, w) { # sum(w * x) that asserts w and accepts NULL
+  if (is.null(w)) {
+    return(sum(x))
+  }
+  assert_numeric(w, lower = 0, finite = TRUE, any.missing = FALSE, len = length(x))
+  sum(x * w)
+}
+
 # confusion matrix
 cm = function(truth, response, positive = NULL) {
   if (!is.null(positive)) {

R/regr_sae.R

@@ -2,20 +2,27 @@
 #'
 #' @details
 #' The Sum of Absolute Errors is defined as \deqn{
-#'   \sum_{i=1}^n \left| t_i - r_i \right|.
+#'   \sum_{i=1}^n w_i \left| t_i - r_i \right|.
 #' }{
-#'   sum(abs((t - r))).
+#'   sum(w * abs((t - r))).
 #' }
+#' where \eqn{w_i} are unnormalized weights for each observation \eqn{x_i}, defaulting to 1.
 #'
 #' @templateVar mid sae
 #' @template regr_template
 #'
+#' @param sample_weights (`numeric()`)\cr
+#'   Vector of non-negative and finite sample weights.
+#'   Must have the same length as `truth`.
+#'   Weights for this function are not normalized.
+#'   Defaults to sample weights 1.
+#'
 #' @inheritParams regr_params
 #' @template regr_example
 #' @export
-sae = function(truth, response, ...) {
+sae = function(truth, response, sample_weights = NULL, ...) {
   assert_regr(truth, response = response)
-  sum(.ae(truth, response))
+  sum(.ae(truth, response), sample_weights)
 }
 
 #' @include measures.R

R/regr_sse.R

@@ -2,20 +2,27 @@
 #'
 #' @details
 #' The Sum of Squared Errors is defined as \deqn{
-#'   \sum_{i=1}^n \left( t_i - r_i \right)^2.
+#'   \sum_{i=1}^n w_i \left( t_i - r_i \right)^2.
 #' }{
-#'   sum((t - r)^2).
+#'   sum(w * (t - r)^2).
 #' }
+#' where \eqn{w_i} are unnormalized weights for each observation \eqn{x_i}, defaulting to 1.
 #'
 #' @templateVar mid sse
 #' @template regr_template
 #'
+#' @param sample_weights (`numeric()`)\cr
+#'   Vector of non-negative and finite sample weights.
+#'   Must have the same length as `truth`.
+#'   Weights for this function are not normalized.
+#'   Defaults to sample weights 1.
+#'
 #' @inheritParams regr_params
 #' @template regr_example
 #' @export
-sse = function(truth, response, ...) {
+sse = function(truth, response, sample_weights = NULL, ...) {
   assert_regr(truth, response = response)
-  sum(.se(truth, response))
+  wsum(.se(truth, response), sample_weights)
 }
 
 #' @include measures.R