# truecluster/R/munkres.R
# Hungarian Method for non-square matrices
# (C) 2005-2007 Dr. Jens Oehlschlägel
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
###########################################################################

#! \name{munkres}
#! \alias{munkres}
#! \title{ Hungarian method for rectangular cost matrices }
#! \description{
#!   Rows and columns of a cost matrix are matched such that the trace costs are minimized.
#! }
#! \usage{
#!   munkres(x, tieorder = TRUE, tiebreak = TRUE, decreasing = FALSE)
#! }
#! \arguments{
#!   \item{x}{ numeric cost matrix }
#!   \item{tieorder}{ default TRUE to order the diagonal }
#!   \item{tiebreak}{ default TRUE to break ties at random when ordering the diagonal}
#!   \item{decreasing}{ TRUE to order decreasing (default FALSE) }
#! }
#! \details{
#!   The is a version of Munkres' hungarian method, which allows for non-square rectangular cost matrices.
#! }
#! \value{
#!   A list
#!   \item{row}{index for reordering the rows}
#!   \item{col}{index for reordering the columns}
#! }
#! \references{ xx }
#! \author{ Jens Oehlschlägel }
#! \seealso{ \code{\link{tieorder}}, \code{\link{matchindex}}, \code{\link[clue]{solve_LSAP}}, \code{\link[e1071]{matchClasses}} }
#!
#! \examples{
#!  rows <- 4
#!  cols <- 6
#!  mat <- matrix(runif(rows*cols), nrow=rows, ncol=cols)
#!  cat("find the matching minimizing costs\n")
#!  ind <- munkres(mat); mat[ind$row, ind$col]
#!  cat("the same with decreasing order\n")
#!  ind <- munkres(mat, decreasing=TRUE); mat[ind$row, ind$col]
#!  cat("find the matchings maximizing costs\n")
#!  ind <- munkres(-mat); mat[ind$row, ind$col]
#! }
#! \keyword{ utilities }

munkres <- function(x, tieorder=TRUE, tiebreak=TRUE, decreasing=FALSE)
{
  if (any(is.na(x)))
    stop("NAs not allowed")
  d <- dim(x)
  transpose <- d[1]>d[2]
  if (transpose){
    x <- t(x)
    d <- dim(x)
  }
  ret <- .C("R_tc_munkres"
  , Cost = as.double(x)
  , Rn   = as.integer(d[1])
  , Cn   = as.integer(d[2])
  , row = integer(d[1])
  , col = integer(d[2])
  , NAOK = TRUE, DUP = FALSE, PACKAGE = "truecluster"
  )[c("row","col")]
  ret$row <- ret$row + 1
  ret$col <- ret$col[1:d[1]] + 1
  if (tieorder){
    i <- ret$row + (ret$col-1) * d[1]
    o <- tieorder(diag(x[ret$row, ret$col]), decreasing=decreasing, index=i, tiebreak=tiebreak)
    ret$row <- as.integer((o-1)%%d[1] + 1)
    Col <- as.integer((o-1)/d[1]+1)
    if (d[2]>d[1]){
      if(d[2]==(d[1]+1))
        ret$col <- c(Col, setdiff(1:d[2], Col))
      else
        ret$col <- c(Col, sample(setdiff(1:d[2], Col)))
    }else{
      ret$col <- Col
    }
  }else{
    ret$col <- c(ret$col, setdiff(1:d[2], ret$col))
  }
  if (transpose){
    list(row=ret$col, col=ret$row)
  }else{
    ret
  }
}
