R/distances.R

In gabrielteotonio/cModes: Variable-Wise Fuzzy C-Modes Algorithms

# Author: Gabriel Teotonio
# Title: Functions to calculate distances
# Date: 2022-02-22


#' Calculate distance between two nominal vectors
#'
#' @param x First data vector
#' @param v Second data vector
#' @param variation_weight Variation of weights in distance
#' @param lambda Weight values related to vectors structure
#' @param beta Exponent weight values related to vectors structure
#' @return A distance value
#' @noRd
distance_nominal <- function(x,
                             v,
                             variation_weight = "non-adaptive",
                             lambda = NULL,
                             beta = NULL) {
  # Process ----
  if (variation_weight == "non-adaptive") {
    result <- sum(x != v)
  } else if (variation_weight == "local-adaptive-sum" ||
             variation_weight == "global-adaptive-sum") {
    signals <- x != v
    result <- sum(lambda ^ beta * ifelse(signals == FALSE, 1, 0))
  } else {
    signals <- x != v
    result <- sum(lambda * ifelse(signals == FALSE, 1, 0))
  }
  return(result)
}



#' Calculate distance between two vectors
#'
#' @param x First data vector
#' @param v Second data vector
#' @param variation_weight Variation of weights in distance
#' @param type Type of distance related to vectors structure
#' @param lambda Weight values related to vectors structure
#' @param beta Exponent weight values related to vectors structure
#' @return A distance value
#' @export
distance_psi <- function(x,
                         v,
                         variation_weight = "non-adaptive",
                         type = "nominal",
                         lambda = NULL,
                         beta = NULL) {
  # Checks ----
  if (is.na(x) || is.na(v))
    stop("Arguments x e v must be defined.")

  if (!variation_weight %in% c(
    "non-adaptive",
    "local-adaptive-sum",
    "global-adaptive-sum",
    "local-adaptive-product",
    "global-adaptive-product"
  ))
    stop("Argument variation_weight must be a valid one.")

  if (!type %in% c("nominal",
                   "binary",
                   "mixed"))
    stop("Argument type must be a valid one.")

  if (variation_weight != "non-adaptive") {
    if (!is.vector(lambda))
      stop("Argument lambda must be a vector")

    if (variation_weight == "local-adaptive-sum" ||
        variation_weight == "global-adaptive-sum") {
      if (!is.numeric(beta) ||
          beta <= 1)
        stop("Argument beta must be numeric and greater than 1.")
    }
  }

  # Encode ----
  x <- as.character(x)
  v <- as.character(v)

  # Process ----
  if (type == "nominal") {
    if (variation_weight == "non-adaptive") {
      result <- distance_nominal(x, v)
    } else if (variation_weight == "local-adaptive-sum" ||
               variation_weight == "global-adaptive-sum") {
      result <- distance_nominal(x, v, variation_weight, lambda, beta)
    } else {
      result <- distance_nominal(x, v, variation_weight, lambda)
    }

  } else if (type == "binary") {

  } else {

  }
  return(result)
}