R/bipartite.match.R

In zdebruine/LSMF: Least squares matrix factorization

#' Bipartite graph matching
#'
#' @description Hungarian algorithm for matching samples in a bipartite graph from a distance ("cost") matrix
#' 
#' @details This algorithm was cloned from RcppHungarian, an Rcpp wrapper for the original C implementation by Cong Ma (2016).
#'
#' @param costMatrix A distance matrix giving the cost of each possible pairing
#' @return List of components "cost" and "parings", with pairings given as an n x 2 matrix
#' @examples
#' /dontrun{
#' data(moca7k)
#' model1 <- lsmf(moca7k[,1000:2000], k = 10)
#' model2 <- lsmf(moca7k[,2000:300], k = 10)
#' costMatrix <- 1 + 1e-10 - sparse.cos(model1$W, model2$W)
#' matched <- bipartite.match(costMatrix)
#' model2W.reordered <- model2$W[,matched$pairs[,2]]
#' }
bipartite.match <- function(costMatrix){
  if(class(costMatrix)[1] != "matrix") as.matrix(costMatrix)
  if(class(costMatrix)[1] != "matrix") stop("could not convert costMatrix to class 'matrix'")
  if(min(costMatrix) < 0) {
    warning("Negative values detected in costMatrix. Negative values were replaced by zero.")
    costMatrix[costMatrix < 0] <- 0
  }
  if(nrow(costMatrix) != ncol(costMatrix)) warning("Cost matrix is not square. Proceeding on the assumption that it is over- or under-determined.")
  return(bipartiteMatch(costMatrix))
}