[UPDATE] cmatrix()-function 🔥

* `cmatrix()`-function now accepts the argument `w`, a <numeric>-vector of sample weights. 🚀
* Unit-tests: Updated the unit-tests so it can accomodate weighted metrics
* Documentation: Updated documentation on `cmatrix()`-function
* NEWS: Updated news.
* DESCRIPTION: Version bump! 🚀

All tests passed locally.

.github/workflows/R-CMD-check.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at /~https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [development, documentation]
+    branches: [development, documentation, weighted-metrics]
   pull_request:
-    branches: [development, documentation]
+    branches: [development, documentation, weighted-metrics]
 
 name: R-CMD-check
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SLmetrics
 Title: Machine Learning Performance Evaluation on Steroids
-Version: 0.1-1
+Version: 0.2-0
 Authors@R: c(
     person(
       given   = "Serkan", 

NEWS.Rmd

@@ -15,6 +15,38 @@ knitr::opts_chunk$set(
 set.seed(1903) 
 ```
 
+# Version 0.2-0
+
+> Version 0.2-0 is considered pre-release of {SLmetrics}. We do not
+> expect any breaking changes, unless a major bug/issue is reported and its nature
+> forces breaking changes.
+
+## Improvements
+
+* **weighted classification metrics:** All classification metrics now accepts the argument `w` which is the sample weights. If passed the respective function will return the weighted metric. Below is an example using sample weights for the confusion matrix,
+
+```{r}
+# 1) define factors
+actual    <- factor(sample(letters[1:3], 100, replace = TRUE))
+predicted <- factor(sample(letters[1:3], 100, replace = TRUE))
+weights   <- runif(length(actual))
+
+# 2) without weights
+SLmetrics::cmatrix(
+    actual    = actual,
+    predicted = predicted
+)
+
+# 2) with weights
+SLmetrics::cmatrix(
+    actual    = actual,
+    predicted = predicted,
+    w         = weights
+)
+```
+
+
+
 # Version 0.1-1
 
 > Version 0.1-1 is considered pre-release of {SLmetrics}. We do not

NEWS.md

@@ -1,4 +1,51 @@
 
+# Version 0.2-0
+
+> Version 0.2-0 is considered pre-release of {SLmetrics}. We do not
+> expect any breaking changes, unless a major bug/issue is reported and
+> its nature forces breaking changes.
+
+## Improvements
+
+  - **weighted classification metrics:** All classification metrics now
+    accepts the argument `w` which is the sample weights. If passed the
+    respective function will return the weighted metric. Below is an
+    example using sample weights for the confusion matrix,
+
+<!-- end list -->
+
+``` r
+# 1) define factors
+actual    <- factor(sample(letters[1:3], 100, replace = TRUE))
+predicted <- factor(sample(letters[1:3], 100, replace = TRUE))
+weights   <- runif(length(actual))
+
+# 2) without weights
+SLmetrics::cmatrix(
+    actual    = actual,
+    predicted = predicted
+)
+```
+
+    #>    a  b  c
+    #> a 16  6  8
+    #> b 14 10 11
+    #> c  5 15 15
+
+``` r
+# 2) with weights
+SLmetrics::cmatrix(
+    actual    = actual,
+    predicted = predicted,
+    w         = weights
+)
+```
+
+    #>          a        b        c
+    #> a 8.796270 3.581817 3.422532
+    #> b 6.471277 4.873632 5.732148
+    #> c 0.908202 8.319738 8.484611
+
 # Version 0.1-1
 
 > Version 0.1-1 is considered pre-release of {SLmetrics}. We do not
@@ -92,7 +139,7 @@ plot(
 )
 ```
 
-![](NEWS_files/figure-gfm/unnamed-chunk-2-1.png)<!-- -->
+![](NEWS_files/figure-gfm/unnamed-chunk-3-1.png)<!-- -->
 
 ``` r
 plot(
@@ -101,7 +148,7 @@ plot(
 )
 ```
 
-![](NEWS_files/figure-gfm/unnamed-chunk-2-2.png)<!-- -->
+![](NEWS_files/figure-gfm/unnamed-chunk-3-2.png)<!-- -->
 
 # Version 0.1-0
 
@@ -125,7 +172,7 @@ print(
 )
 ```
 
-    #>  [1] a a a b c a b c c a
+    #>  [1] a b b a c b b a b c
     #> Levels: a b c
 
 ``` r
@@ -137,7 +184,7 @@ print(
 )
 ```
 
-    #>  [1] c c b b a a b b c b
+    #>  [1] a b b a a c a b b c
     #> Levels: a b c
 
 ``` r
@@ -155,16 +202,16 @@ summary(
     #> Confusion Matrix (3 x 3) 
     #> ================================================================================
     #>   a b c
-    #> a 1 2 2
-    #> b 0 2 0
-    #> c 1 1 1
+    #> a 2 1 0
+    #> b 1 3 1
+    #> c 1 0 1
     #> ================================================================================
     #> Overall Statistics (micro average)
-    #>  - Accuracy:          0.40
-    #>  - Balanced Accuracy: 0.51
-    #>  - Sensitivity:       0.40
-    #>  - Specificity:       0.70
-    #>  - Precision:         0.40
+    #>  - Accuracy:          0.60
+    #>  - Balanced Accuracy: 0.59
+    #>  - Sensitivity:       0.60
+    #>  - Specificity:       0.80
+    #>  - Precision:         0.60
 
 ``` r
 # 2) calculate false positive
@@ -175,7 +222,7 @@ SLmetrics::fpr(
 ```
 
     #>         a         b         c 
-    #> 0.2000000 0.3750000 0.2857143
+    #> 0.2857143 0.2000000 0.1250000
 
 ### Supervised regression metrics
 
@@ -196,4 +243,4 @@ SLmetrics::huberloss(
 )
 ```
 
-    #> [1] 0.4757045
+    #> [1] 0.5281794

R/RcppExports.R

@@ -61,13 +61,16 @@ ckappa.cmatrix <- function(x, beta = 1.0, ...) {
 #' @usage
 #' cmatrix(
 #'   actual,
-#'   predicted
+#'   predicted,
+#'   w
 #' )
 #'
 #' @param actual A <[factor]>-vector of [length] \eqn{n}, and \eqn{k} levels.
 #' @param predicted A <[factor]>-vector of [length] \eqn{n}, and \eqn{k} levels.
+#' @param w A <[numeric]>--vector of [length] \eqn{n}. [NULL] by default. If passed it will return a weighted confusion matrix.
 #'
 #' @example man/examples/scr_confusionmatrix.R
+#' @example man/examples/scr_wconfusionmatrix.R
 #' @family classification
 #'
 #' @inherit specificity details
@@ -89,8 +92,8 @@ ckappa.cmatrix <- function(x, beta = 1.0, ...) {
 #' A named \eqn{k} x \eqn{k} <[matrix]> of [class] <cmatrix>
 #'
 #' @export
-cmatrix <- function(actual, predicted) {
-    .Call(`_SLmetrics_cmatrix`, actual, predicted)
+cmatrix <- function(actual, predicted, w = NULL) {
+    .Call(`_SLmetrics_cmatrix`, actual, predicted, w)
 }
 
 #' @rdname dor

man/examples/scr_wconfusionmatrix.R

@@ -0,0 +1,61 @@
+# 1) recode Iris
+# to binary classification
+# problem
+iris$species_num <- as.numeric(
+  iris$Species == "virginica"
+)
+
+# 1.1) set some arbitrary
+# weight
+iris$weights <- rbeta(
+  n = nrow(iris),
+  shape1 = 20,
+  shape2 = 1
+)
+
+# 2) fit the logistic
+# regression
+model <- glm(
+  formula = species_num ~ Sepal.Length + Sepal.Width,
+  data    = iris,
+  family  = binomial(
+    link = "logit"
+  ),
+  weights = iris$weights
+)
+
+# 3) generate predicted
+# classes
+predicted <- factor(
+  as.numeric(
+    predict(model, type = "response") > 0.5
+  ),
+  levels = c(1,0),
+  labels = c("Virginica", "Others")
+)
+
+# 3.1) generate actual
+# classes
+actual <- factor(
+  x = iris$species_num,
+  levels = c(1,0),
+  labels = c("Virginica", "Others")
+)
+
+# 4) confusion matrix
+confusion_matrix <- cmatrix(
+  actual    = actual,
+  predicted = predicted,
+  w         = iris$weights
+)
+
+# 4.1) summarise matrix
+summary(
+  confusion_matrix
+)
+
+# 4.2) plot confusion
+# matrix
+plot(
+  confusion_matrix
+)

src/RcppExports.cpp

@@ -86,14 +86,15 @@ BEGIN_RCPP
 END_RCPP
 }
 // cmatrix
-Rcpp::NumericMatrix cmatrix(const Rcpp::IntegerVector& actual, const Rcpp::IntegerVector& predicted);
-RcppExport SEXP _SLmetrics_cmatrix(SEXP actualSEXP, SEXP predictedSEXP) {
+Rcpp::NumericMatrix cmatrix(const Rcpp::IntegerVector& actual, const Rcpp::IntegerVector& predicted, const Rcpp::Nullable<Rcpp::NumericVector>& w);
+RcppExport SEXP _SLmetrics_cmatrix(SEXP actualSEXP, SEXP predictedSEXP, SEXP wSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< const Rcpp::IntegerVector& >::type actual(actualSEXP);
     Rcpp::traits::input_parameter< const Rcpp::IntegerVector& >::type predicted(predictedSEXP);
-    rcpp_result_gen = Rcpp::wrap(cmatrix(actual, predicted));
+    Rcpp::traits::input_parameter< const Rcpp::Nullable<Rcpp::NumericVector>& >::type w(wSEXP);
+    rcpp_result_gen = Rcpp::wrap(cmatrix(actual, predicted, w));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -969,7 +970,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_SLmetrics_baccuracy_cmatrix", (DL_FUNC) &_SLmetrics_baccuracy_cmatrix, 2},
     {"_SLmetrics_ckappa", (DL_FUNC) &_SLmetrics_ckappa, 3},
     {"_SLmetrics_ckappa_cmatrix", (DL_FUNC) &_SLmetrics_ckappa_cmatrix, 2},
-    {"_SLmetrics_cmatrix", (DL_FUNC) &_SLmetrics_cmatrix, 2},
+    {"_SLmetrics_cmatrix", (DL_FUNC) &_SLmetrics_cmatrix, 3},
     {"_SLmetrics_dor", (DL_FUNC) &_SLmetrics_dor, 4},
     {"_SLmetrics_dor_cmatrix", (DL_FUNC) &_SLmetrics_dor_cmatrix, 3},
     {"_SLmetrics_fbeta", (DL_FUNC) &_SLmetrics_fbeta, 5},