R/misclassification.R

In psobczyk/varclust: Variables Clustering

#' Computes misclassification rate
#'
#' Missclasification is a commonly used performance measure in subspace
#' clustering. It allows to compare two partitions with the same number of
#' clusters.
#'
#' As getting exact value of misclassification requires checking all
#' permutations and is therefore intrackable even for modest number of clusters,
#' a heuristic approach is proposed. It is assumed that there are K classes of
#' maximum M elements. Additional requirement is that classes labels are from
#' range [1, K].
#'
#' @param group A vector, first partition.
#' @param true_group A vector, second (reference) partition.
#' @param M An integer, maximal number of elements in one class.
#' @param K An integer, number of classes.
#' @references {R. Vidal. Subspace clustering. Signal Processing Magazine, IEEE,
#'   28(2):52-68,2011}
#' @export
#' @return Misclassification rate.
#' @examples
#' \donttest{
#' sim.data <- data.simulation(n = 100, SNR = 1, K = 5, numb.vars = 30, max.dim = 2)
#' mlcc.fit <- mlcc.reps(sim.data$X, numb.clusters = 5, numb.runs = 20, max.dim = 2, numb.cores = 1)
#' misclassification(mlcc.fit$segmentation, sim.data$s, 30, 5)
#'
#'
#' # one can use this function not only for clusters
#' partition1 <- sample(10, 300, replace = TRUE)
#' partition2 <- sample(10, 300, replace = TRUE)
#' misclassification(partition1, partition1, max(table(partition1)), 10)
#' misclassification(partition1, partition2, max(table(partition2)), 10)
#' }
misclassification <- function(group, true_group, M, K) {
  if (length(group) != length(true_group)) {
    stop("Partitions are of different lengths")
  }
  forbidden <- NULL
  suma <- 0
  nG <- max(group)
  for (i in M:1) { # differnet concordance levels
    for (j in 1:nG) { # subspaces numbers (found)
      if (sum(j == forbidden) == 0) { # subspace not yet used
        for (k in 1:K) { # subspaces numbers (true)
          if (sum(j == group[true_group == k]) == i) {
            suma <- suma + i
            forbidden <- c(forbidden, j)
            break
          }
        }
      }
    }
  }
  mis <- 1 - suma / length(true_group)
  return(mis)
}