R/gower.distance_function.R

In rnmamod: Bayesian Network Meta-Analysis with Missing Participants

#' Weighted Gower's dissimilarity measure
#' (Trials' comparability for transitivity evaluation)
#'
#' @description
#'   \code{gower_distance} calculate the weighted Gower's dissimilarity
#'   coefficient for all pairs of trials included in a network of interventions,
#'   considering several characteristics measured at trial level
#'   (Spineli et al., 2025).
#'   It takes values from 0 to 1, with 0 implying complete similarity and 1
#'   complete dissimilarity.
#'
#' @param input A data-frame in the long arm-based format. Two-arm trials occupy
#'   one row in the data-frame. Multi-arm trials occupy as many rows as the
#'   number of possible comparisons among the interventions. The first two
#'   columns refer to the trial name, and the pairwise comparison,
#'   respectively. The remaining columns refer to summary characteristics. See
#'   'Details' for the specification of the columns.
#' @param weight A vector of non-negative numbers to define the weight
#'   contribution of each characteristic. The default is a vector of 1s for all
#'   characteristics.
#'
#' @return
#'   \code{gower_distance} returns the following list of elements:
#'   \item{Dissimilarity_table}{A lower off-diagonal matrix of 'dist' class
#'   with the dissimilarities of all pairs of trials.}
#'   \item{Types_used}{A data-frame with type mode (i.e., double or integer) of
#'   each characteristic.}
#'   \item{Total_missing}{The percentage of missing cases in the comparison,
#'   calculated as the ratio of total missing cases to the product of the number
#'   of studies with the number of characteristics.}
#'
#' @details
#'   The correct type mode of columns in \code{input} must be ensured to use
#'   the function \code{gower_distance}. The first two columns referring to
#'   the trial name, and pairwise comparison, respectively, must
#'   be \strong{character}. The remaining columns referring to the
#'   characteristics must be \strong{double} or \strong{integer} depending on
#'   whether the corresponding characteristic refers to a quantitative or
#'   qualitative variable. The type mode of each column is assessed by
#'   \code{gower_distance} using the base function \code{typeof}. Note that
#'   \code{gower_distance} invites unordered and ordered variables; for the
#'   latter, add the argument \code{ordered = TRUE} in the base function
#'   \bold{factor()}.
#'
#'  \code{gower_distance} is integrated in the function
#'   \code{\link{comp_clustering}}.
#'
#' @author {Loukia M. Spineli}
#'
#' @seealso
#'   \code{\link{comp_clustering}}
#'
#' @references
#' Gower J. General Coefficient of Similarity and Some of Its Properties.
#' \emph{Biometrics} 1971;\bold{27}(4):857--71.
#' doi: 10.2307/2528823
#'
#' Spineli LM, Papadimitropoulou K, Kalyvas C. Exploring the Transitivity
#' Assumption in Network Meta-Analysis: A Novel Approach and Its Implications.
#' \emph{Stat Med} 2025;\bold{44}(7):e70068.
#' doi: 10.1002/sim.70068.
#'
#' @examples
#' # Fictional dataset
#' data_set <- data.frame(Trial_name = as.character(1:7),
#'                       comp = c("1vs2", "1vs2", "1vs2", "1vs3", "1vs3", "2vs3", "2vs3"),
#'                       sample = c(140, 145, 150, 40, 45, 75, 80),
#'                       age = c(18, 18, 18, 48, 48, 35, 35),
#'                       blinding = as.integer(c("yes", "yes", "yes", "no", "no", "no", "no")))
#'
#' # Calculate the weighted Gower dissimilarity of all study pairs in the network
#' gower_distance(input = data_set)
#'
#' @export
gower_distance <- function (input, weight) {


  ## Default arguments
  # Check if the dataset is correct
  input <- if (any(sapply(input, typeof)[1:2] != "character")) {
    stop("The first two columns (trial and comparison) must be 'characters').",
         call. = FALSE)
  } else if (any(sapply(input, typeof)[-c(1, 2)] == "character")) {
    stop("The characteristics must be 'double' or 'integer'.", call. = FALSE)
  } else {
    input
  }
  weight <- if (missing(weight)) {
    rep(1, dim(input)[2] - 2)
  } else {
    weight
  }

  ## Remove the first two columns
  data <- as.data.frame(input[, -c(1:2)])


  ## Table with the variable type
  char_type <- data.frame(characteristic = colnames(data),
                          type = sapply(data, typeof))
  rownames(char_type) <- 1:dim(data)[2]


  ## Set the necessary matrices
  data_dist0 <- data_dist <- delta_dummy <-
    matrix(NA, nrow = dim(combn(dim(data)[1], 2))[2], ncol = dim(data)[2])


  ## Obtain the distances and deltas per variable
  for (i in 1:dim(data)[2]) {

    ## Then, get the dissimilarities per variable
    data_dist0[, i] <-
      # Numeric
      if (typeof(data[, i]) == "double" &
          length(na.omit(unique(data[, i]))) > 1) {
        abs(apply(combn(data[, i], 2), 2, diff)) / diff(range(data[, i],
                                                              na.rm = TRUE))

        # Numeric (Same value for all trials)
      } else if (typeof(data[, i]) == "double" &
                 length(na.omit(unique(data[, i]))) == 1) {
        0

        # Nominal unordered (if binary, it is considered symmetric)
      } else if (typeof(data[, i]) != "double" &
                 length(class(data[, i])) == 1) {
        ifelse(apply(combn(data[, i], 2), 2, diff) == 0, 0, 1)

        # Nominal ordered
      } else if (typeof(data[, i]) != "double" &
                 length(class(data[, i])) == 2) {
        abs(apply(combn(rank(data[, i]), 2), 2, diff)) /
          diff(range(rank(data[, i]), na.rm = TRUE))
      }

    ## Finally, get the deltas per variable
    delta_dummy[, i] <-
      ifelse(!is.na(apply(combn(data[, i], 2), 2, diff)), 1, 0)
  }


  ## Turn the 'weight' into a matrix with same dimensions as delta_dummy
  weight_new <- matrix(rep(weight, dim(delta_dummy)[1]),
                       nrow = dim(delta_dummy)[1],
                       ncol = dim(delta_dummy)[2],
                       byrow = TRUE)


  ## Gower's formula (weighted average of distances)
  data_dist <- if (max(data_dist0, na.rm = TRUE) == 0) {
    #stop("Dissimilarity matrix is zero for all comparisons.", call. = FALSE)
    0
  } else {
    (apply((data_dist0 * delta_dummy) * weight_new, 1, sum, na.rm = TRUE) /
       apply(delta_dummy * weight_new, 1, sum))
  }


  ## Turn Gower dissimilarity into a lower triangle
  dist_mat <- matrix(NA, nrow = dim(data)[1], ncol = dim(data)[1])
  dist_mat[lower.tri(dist_mat, diag = FALSE)] <- data_dist
  diag(dist_mat) <- 0


  ## Remove redundant row and column
  #dist_mat <- as.data.frame(dist_mat0[-1, -dim(data)[1]])
  #rownames(dist_mat) <- input[-1, 1]
  #colnames(dist_mat) <- input[-dim(input)[1], 1]


  ## Name the rows (trial pairs) in 'data_dist0'
  rownames(data_dist0) <- apply(combn(input[, 1], 2), 2, function(x) paste(x, collapse = "-"))


  ## Percentage total missing data
  total_mod <-
    round((sum(is.na(input[, -c(1, 2)]) == TRUE) /
             (dim(input[, -c(1, 2)])[1] * dim(input[, -c(1, 2)])[2])) * 100, 2)


  ## Collect the results
  results <- list(Dissimilarity_table = dist_mat,
                  Types_used = char_type,
                  Total_missing = paste0(total_mod, "%"),
                  Variable_dissimilarities = data_dist0)

  return(results)
}