Add scaling and centering

NAMESPACE

@@ -12,6 +12,7 @@ S3method(mean,CompositionMatrix)
 S3method(plot,CompositionMatrix)
 S3method(plot,LogRatio)
 S3method(plot,OutlierIndex)
+S3method(scale,CompositionMatrix)
 export(pca)
 export(remove_NA)
 export(remove_zero)
@@ -56,6 +57,7 @@ exportMethods(powering)
 exportMethods(replace_NA)
 exportMethods(replace_zero)
 exportMethods(scalar)
+exportMethods(scale)
 exportMethods(transform_alr)
 exportMethods(transform_clr)
 exportMethods(transform_ilr)

R/AllGenerics.R

@@ -774,6 +774,29 @@ setGeneric(
 #   valueClass = "matrix"
 # )
 
+#' Scaling and Centering of Compositional Data
+#'
+#' @param x A [`CompositionMatrix-class`] object.
+#' @param center A [`logical`] scalar or a [`numeric`] vector giving the center
+#'  to be substracted.
+#' @param scale A [`logical`] scalar or a length-one [`numeric`] vector giving a
+#'  scaling factor for multiplication.
+#' @return A [`CompositionMatrix-class`] object.
+#' @references
+#'  Aitchison, J. (1986). *The Statistical Analysis of Compositional Data*.
+#'  London: Chapman and Hall, p. 64-91. \doi{10.1007/978-94-009-4109-0}.
+#'
+#'  Boogaart, K. G. van den & Tolosana-Delgado, R. (2013). *Analyzing
+#'  Compositional Data with R*. Berlin Heidelberg: Springer-Verlag.
+#'  \doi{10.1007/978-3-642-36809-7}.
+#' @example inst/examples/ex-scale.R
+#' @author N. Frerebeau
+#' @docType methods
+#' @family statistics
+#' @name scale
+#' @rdname scale
+NULL
+
 # Distances ====================================================================
 #' Distances
 #'

R/simplex.R

@@ -34,12 +34,16 @@ setMethod(
   signature = c(x = "CompositionMatrix", y = "CompositionMatrix"),
   definition = function(x, y) {
     arkhe::assert_dimensions(y, dim(x))
+
     if (all(x <= 0)) x <- 1 / x
     if (all(y <= 0)) y <- 1 / y
+
     z <- x * y
     z <- as_composition(z)
+
     set_samples(z) <- get_samples(x)
     set_groups(z) <- get_groups(x)
+
     z
   }
 )
@@ -63,6 +67,7 @@ setMethod(
   f = "perturbation",
   signature = c(x = "CompositionMatrix", y = "numeric"),
   definition = function(x, y) {
+    y <- matrix(data = y, nrow = nrow(x), ncol = length(y), byrow = TRUE)
     x %perturbe% as_composition(y)
   }
 )

R/statistics.R

@@ -96,6 +96,36 @@ gmean <- function(x, trim = 0, na.rm = FALSE) {
   exp(mean(log(unclass(x)[index]), trim = trim, na.rm = na.rm))
 }
 
+# Scale ========================================================================
+#' @export
+#' @method scale CompositionMatrix
+scale.CompositionMatrix <- function(x, center = TRUE, scale = TRUE) {
+  if (isFALSE(center) & isFALSE(scale)) return(x)
+
+  y <- x
+  if (!isFALSE(center)) {
+    if (isTRUE(center)) center <- mean(x)
+    arkhe::assert_type(center, "numeric")
+    arkhe::assert_length(center, NCOL(x))
+
+    y <- perturbation(y, 1 / center)
+  }
+
+  if (!isFALSE(scale)) {
+    if (isTRUE(scale)) scale <- sqrt(mean(diag(covariance(x, center = TRUE))))
+    arkhe::assert_type(scale, "numeric")
+
+    y <- powering(y, 1 / scale)
+  }
+
+  y
+}
+
+#' @export
+#' @rdname scale
+#' @aliases scale,CompositionMatrix-method
+setMethod("scale", "CompositionMatrix", scale.CompositionMatrix)
+
 # Metric variance ==============================================================
 #' @export
 #' @rdname metric_var

inst/examples/ex-scale.R

@@ -0,0 +1,8 @@
+## Coerce to compositional data
+data("hongite")
+coda <- as_composition(hongite)
+
+## Center and scale
+scaled <- scale(coda, center = TRUE, scale = TRUE)
+mean(scaled)
+head(scaled)

inst/tinytest/test_statistics.R

@@ -1,6 +1,14 @@
 data("hongite")
 coda <- as_composition(hongite)
 
+# Mean =========================================================================
+expect_equal_to_reference(mean(coda), file = "_snaps/mean.rds")
+
+# Scale ========================================================================
+z <- scale(coda, center = TRUE, scale = TRUE)
+expect_equal(mean(z), c(A = 0.2, B = 0.2, C = 0.2, D = 0.2, E = 0.2))
+expect_equal_to_reference(z, file = "_snaps/scale.rds")
+
 # Margin =======================================================================
 expect_equal_to_reference(margin(coda, parts = c("B", "D")), file = "_snaps/margin.rds")