R/bowl_transform.R

In dcorBSS: Distance-Correlation Based Methods for Blind Source Separation and Dependence Analysis

#' Bowl Transformation 
#'
#' Apply the bowl transformation proposed for robust distance-correlation based
#' independent component analysis. The transformation is bounded, one-to-one,
#' and continuous, and maps far outlying observations close to the origin while
#' preserving the key implication that zero distance correlation implies
#' independence after transformation.
#'
#' By default, the input is not standardized before the transformation is
#' applied. Optional centering and scaling can be requested through
#' `do_scale = TRUE`.
#'
#' @param X A numeric data matrix or an object coercible to a matrix. Rows are
#'   observations and columns are variables.
#' @param alpha A probability level used to define the cutoff
#'   \eqn{q = \sqrt{\chi^2_{p,\alpha}}}, where \eqn{p} is the number of columns
#'   of `X`. Must satisfy `0 < alpha < 1`.
#' @param do_scale Logical; if `TRUE`, standardize the columns of `X` before
#'   applying the bowl transformation.
#' @param location Optional centering vector used when `do_scale = TRUE`.
#'   Defaults to [stats::median()]. Ignored otherwise.
#' @param scale Optional scaling vector used when `do_scale = TRUE`.
#'   Defaults to [stats::mad()]. Ignored otherwise.
#'
#' @return A numeric matrix with `nrow(X)` rows and `ncol(X) + 1` columns.
#'   The first `ncol(X)` columns contain the transformed coordinates and the
#'   final column contains the additional radial component introduced by the
#'   bowl transformation.
#'
#' @details
#' Let \eqn{x_i} be an observation, \eqn{\|x_i\|} its Euclidean norm, and
#' \eqn{q = \sqrt{\chi^2_{p,\alpha}}}. Define
#' \deqn{u_i = \tanh(\|x_i\| / q).}
#' The transformed observation is then
#' \deqn{\left(10u_i^2(1-u_i)^2 x_i,\; 10u_i^6(1-u_i)^2\right).}
#'
#'
#' @references
#' Leyder, S., Raymaekers, J., Rousseeuw, P. J., Van Deuren, T., and Verdonck,
#' T. (2026). Independent component analysis by robust distance correlation.
#' \emph{Advances in Data Analysis and Classification}, \strong{20}, 727--765.
#' <doi:10.1007/s11634-026-00674-9>
#'
#' @examples
#' X <- cbind(rnorm(10), rt(10, df = 4))
#'
#' bowl_transform(X)
#' bowl_transform(X, do_scale = TRUE)
#' bowl_transform(X, alpha = 0.99)
#'
#' @export
bowl_transform <- function(X,
                           alpha = 0.9975,
                           do_scale = FALSE,
                           location = NULL,
                           scale = NULL) {
  X <- as.matrix(X)

  if (!is.numeric(X)) {
    stop("`X` must be numeric.")
  }
  if (!isTRUE(all.equal(alpha > 0 && alpha < 1, TRUE))) {
    stop("`alpha` must satisfy 0 < alpha < 1.")
  }
  if (!is.logical(do_scale) || length(do_scale) != 1L || is.na(do_scale)) {
    stop("`do_scale` must be a single TRUE/FALSE value.")
  }

  p <- ncol(X)

  if (do_scale) {
    if (is.null(location) && is.null(scale)) {
      location <- apply(X, 2, stats::median)
      scale <- apply(X, 2, stats::mad)
      .check_scale_positive(scale)
      X <- scale(X, center = location, scale = scale)
    } else {
      if (is.null(location)) {
        location <- apply(X, 2L, stats::median)
      }
      if (is.null(scale)) {
        scale <- apply(X, 2L, stats::mad)
      }
      if (length(location) != p) {
        stop("`location` must have length ncol(X) when supplied.")
      }
      if (length(scale) != p) {
        stop("`scale` must have length ncol(X) when supplied.")
      }
      .check_scale_positive(scale)
      X <- scale(X, center = location, scale = scale)
    }
  }

  xnorm <- sqrt(rowSums(X^2))
  q <- sqrt(stats::qchisq(alpha, df = p))
  u <- tanh(xnorm / q)
  xx <- 10 * u^2 * (1 - u)^2 * X
  y <- 10 * u^6 * (1 - u)^2

  cbind(xx, y)
}