view release on metacpan or  search on metacpan

lib/Algorithm/Munkres.pm  view on Meta::CPAN

package Algorithm::Munkres;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw( assign );

our $VERSION = '0.08';

#Variables global to the package
my @mat = ();
my @mask = ();
my @colcov = ();
my @rowcov = ();
my $Z0_row = 0;
my $Z0_col = 0;
my @path = ();

#The exported subroutine.
#Expected Input: Reference to the input matrix (MxN)
#Output: Mx1 matrix, giving the column number of the value assigned to each row. (For more explaination refer perldoc)
sub assign
{
    #reference to the input matrix
    my $rmat = shift;
    my $rsolution_mat = shift;
    my ($row, $row_len) = (0,0);

    # re-initialize that global variables
    @mat = ();
    @mask = ();
    @colcov = ();
    @rowcov = ();
    $Z0_row = 0;
    $Z0_col = 0;
    @path = ();

    #variables local to the subroutine
    my $step = 0;
    my ($i, $j) = (0,0);

    #the input matrix
    my @inp_mat = @$rmat;

    #copy the orginal matrix, before applying the algorithm to the matrix
    foreach (@inp_mat)
    {
	push @mat, [ @$_ ];
    }

    #check if the input matrix is well-formed i.e. either square or rectangle.
    $row_len = $#{$mat[0]};
    foreach my $row (@mat)
    {
	if($row_len != $#$row)
	{
	    die "Please check the input matrix.\nThe input matrix is not a well-formed matrix!\nThe input matrix has to be rectangular or square matrix.\n";
	}
    }

    #check if the matrix is a square matrix, 
    #if not convert it to square matrix by padding zeroes.
    if($#mat < $#{$mat[0]})
    {
	# Add rows
	my $diff = $#{$mat[0]} - $#mat;
	for (1 .. $diff)
	{
	    push @mat, [ (0) x @{$mat[0]} ];
	}
    }
    elsif($#mat > $#{$mat[0]})
    {
	# Add columns
	my $diff = $#mat - $#{$mat[0]};
	for (0 .. $#mat)
	{
	    push @{$mat[$_]}, (0) x $diff;
	}
    }

    #initialize mask, column cover and row cover matrices
    clear_covers();

    for($i=0;$i<=$#mat;$i++)
    {
 	push @mask, [ (0) x @mat ];
    }