Algorithm-Bertsekas
view release on metacpan or search on metacpan
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
package Algorithm::Bertsekas;
use strict;
use warnings FATAL => 'all';
use diagnostics;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw( auction );
our $VERSION = '0.87';
#Variables global to the package
my $maximize_total_benefit;
my $matrix_spaces; # used to print messages on the screen
my $decimals; # the number of digits after the decimal point
my ( $array1_size, $array2_size, $min_size, $max_size, $original_max_size );
my ( $need_transpose, $inicial_price, $iter_count_global, $iter_count_local );
my ( $epsilon_scaling, $max_epsilon_scaling, $max_matrix_value, $target, $output );
my ( %index_correlation, %assignned_object, %assignned_person, %price_object );
my ( %objects_desired_by_this, %locked_list, %seen_person, %seen_assignned_objects );
sub auction { # => default values
my %args = ( matrix_ref => undef, # reference to array: matrix N x M
maximize_total_benefit => 0, # 0: minimize_total_benefit ; 1: maximize_total_benefit
inicial_stepsize => undef, # auction algorithm terminates with a feasible assignment if the problem data are integer and stepsize < 1/min(N,M)
inicial_price => 0,
verbose => 3, # level of verbosity, 0: quiet; 1, 2, 3, 4, 5, 8, 9, 10: debug information.
@_, # argument pair list goes here
);
$max_matrix_value = 0;
$iter_count_global = 0;
$epsilon_scaling = 0;
$need_transpose = 0;
%index_correlation = ();
%assignned_object = ();
%assignned_person = ();
%price_object = ();
%objects_desired_by_this = ();
%locked_list = ();
%seen_person = ();
my @matrix_input = @{$args{matrix_ref}}; # Input: Reference to the input matrix (NxM) = $min_size x $max_size
$array1_size = $#matrix_input + 1;
$array2_size = $#{$matrix_input[0]} + 1;
$min_size = $array1_size < $array2_size ? $array1_size : $array2_size ; # square matrix --> $min_size = $max_size and $array1_size = $array2_size
$max_size = $array1_size < $array2_size ? $array2_size : $array1_size ;
$original_max_size = $max_size;
$target = 'auction-' . $array1_size . 'x' . $array2_size . '-output.txt' ;
if ( $args{verbose} >= 8 ){
print "\n verbose = $args{verbose} ---> print the verbose messages to <$target> file \n";
if ( open ( $output, '>', $target ) ) {
print "\n *** Open <$target> for writing. *** \n";
} else {
$args{verbose} = 7;
warn "\n *** Could not open <$target> for writing: $! *** \n";
}
}
$maximize_total_benefit = $args{maximize_total_benefit};
my $optimal_benefit = 0;
my %assignment_hash; # assignment: a hash representing edges in the mapping, as in the Algorithm::Kuhn::Munkres.
my @output_index; # output_index: an array giving the number of the value assigned, as in the Algorithm::Munkres.
my @matrix;
my @matrix_index;
foreach ( @matrix_input ){ # copy the orginal matrix N x M
push @matrix, [ @$_ ];
}
if ( $max_size <= 1 ){ # matrix_input 1 x 1
$assignment_hash{0} = 0;
$output_index[0] = 0;
$matrix_index[0] = 0;
$optimal_benefit = $matrix_input[0]->[0];
}
$need_transpose = 1 if ( $array1_size > $array2_size ); # will always be chosen N <= M
if ( $need_transpose ){
my $transposed = transpose(\@matrix);
@matrix = @$transposed;
}
get_matrix_info( \@matrix, $args{verbose} );
delete_multiple_columns( \@matrix, $args{verbose} ) if ( $min_size >= 2 and $min_size != $max_size );
# epsilon is the stepsize and auction algorithm terminates with a feasible assignment if the problem data are integer and epsilon < 1/min(N,M).
# There is a trade-off between runtime and the chosen stepsize. Using the largest possible increment accelerates the algorithm.
$inicial_price = $args{inicial_price};
$price_object{$_} = $inicial_price for ( 0 .. $max_size - 1 );
#$price_object{$_} = sprintf( "%.0f", rand($max_matrix_value) ) for ( 0 .. $max_size - 1 ); # random values for initial prices
# inicial epsilon value
my $epsilon = int (($max_matrix_value/2) * exp ( -1 * $max_size/$min_size )); # exp (1) = e = 2.71828182845905
$epsilon = $args{inicial_stepsize} if ( defined $args{inicial_stepsize} );
$epsilon = 1/(1+$min_size) if ($epsilon < 1/$min_size);
# (inicial epsilon value) / factor ** k = 1/$min_size --> epsilon * $min_size = factor ** k
# log(epsilon * $min_size) = k * log(factor) --> log(factor) = (log(epsilon * $min_size)) / k --> factor = exp ( (log(epsilon * $min_size)) / k )
#$max_epsilon_scaling = 20;
#my $factor = exp ( (log( $epsilon * (1+$min_size) )) / ($max_epsilon_scaling-1) ); print "\n \$max_epsilon_scaling = $max_epsilon_scaling ; \$factor = $factor \n";
my $factor = 4; # $factor > 1
$max_epsilon_scaling = 2 + int( log( (1+$min_size) * $epsilon )/log($factor) ); # print "\n \$max_epsilon_scaling = $max_epsilon_scaling \n";
my $feasible_assignment_condition = 0;
# The preceding observations suggest the idea of epsilon-scaling, which consists of applying the algorithm several times,
# starting with a large value of epsilon and successively reducing epsilon until it is less than some critical value.
while( $epsilon >= 1/(1+$min_size) and $max_size >= 2 ){
$epsilon_scaling++;
$iter_count_local = 0;
%assignned_object = ();
%assignned_person = ();
%seen_person = ();
$seen_assignned_objects{$_} = 0 for ( 0 .. $max_size - 1 );
while ( (scalar keys %assignned_person) < $max_size ){ # while there is at least one element not assigned.
$iter_count_global++;
$iter_count_local++;
auctionRound( \@matrix, $epsilon, $args{verbose} );
if ( $args{verbose} >= 10 ){
for my $i ( -1 .. $#matrix ) {
if ($i >= 0){ printf $output " %2s [", $i; } else{ printf $output "object"; }
for my $j ( 0 .. $#{$matrix[$i]} ) {
if ($i >= 0){ printf $output (" %${matrix_spaces}.${decimals}f", $matrix[$i]->[$j]); } else{ printf $output (" %${matrix_spaces}.0f", $j); }
if ( defined $assignned_person{$i} and $j == $assignned_person{$i} ){ print $output "**"; } else{ print $output " "; }
}
if ($i >= 0){ print $output "]\n"; } else{ print $output "\n\n"; }
}
}
}
$epsilon = $epsilon / $factor ; # (1/2): smooth convergence
if ( not $feasible_assignment_condition and $epsilon < 1/$min_size ){
$epsilon = 1/(1+$min_size);
$feasible_assignment_condition = 1;
}
}
$epsilon = $factor * $epsilon; # correcting information for printing
my %seeN;
my %seeM;
foreach my $person ( sort { $a <=> $b } keys %assignned_person ){
my $object = $assignned_person{$person};
$matrix_index[$person] = $object;
#print " \$need_transpose = $need_transpose ; \$matrix_index[$person] = $object ; \$index_i = $person ; \$index_j = $object --> $index_correlation{$object} ;";
my $index_i = $need_transpose ? $index_correlation{$object} // $object : $person;
my $index_j = $need_transpose ? $person : $index_correlation{$object} // $object;
$output_index[$index_i] = $index_j;
$seeN{$index_i}++;
$seeM{$index_j}++;
#print " \$output_index[$index_i] = $index_j \n";
next unless ( defined $matrix_input[$index_i] and defined $matrix_input[$index_i]->[$index_j] );
$assignment_hash{ $index_i } = $index_j;
$optimal_benefit += $matrix_input[$index_i]->[$index_j];
}
for my $i ( 0 .. $original_max_size - 1 ) {
for my $j ( 0 .. $original_max_size - 1 ) {
next if ($seeN{$i} or $seeM{$j});
$output_index[$i] = $j;
$seeN{$i}++;
$seeM{$j}++;
last;
}}
if ( $args{verbose} >= 8 ){
printf $output "\n\$optimal_benefit = $optimal_benefit ; \$iter_count_global = $iter_count_global ; \$epsilon = %.4g ; \@output_index = (@output_index) \n", $epsilon;
}
print_screen_messages( \@matrix, \@matrix_index, \@matrix_input, \@output_index, $optimal_benefit, $args{verbose}, $epsilon ) ;
return ( $optimal_benefit, \%assignment_hash, \@output_index ) ;
}
sub transpose {
my $matrix_ref = shift;
my @transpose;
for my $i ( 0 .. $#{$matrix_ref} ) {
for my $j ( 0 .. $#{$matrix_ref->[$i]} ) {
$transpose[$j]->[$i] = $matrix_ref->[$i]->[$j];
}
}
return \@transpose;
}
sub delete_multiple_columns { # if the column elements do not change the final result
my ( $matrix_ref, $verbose ) = @_;
my %lower_values;
my %intersection_columns;
my $number_of_columns_deleted = 0;
for my $i ( 0 .. $#{$matrix_ref} ) {
for my $j ( 0 .. $#{$matrix_ref->[$i]} ) {
$lower_values{ $i }{ $matrix_ref->[$i]->[$j] }{ $j }++;
}
}
# consider N rows < M columns
# remove the matching columns whose elements are never among the N largest elements in each row
foreach my $index_i ( sort { $a <=> $b } keys %lower_values ){
my $num_higher_values = 0;
foreach my $matrix_value ( sort { $b <=> $a } keys %{$lower_values{$index_i}} ){
foreach my $index_j ( sort { $b <=> $a } keys %{$lower_values{$index_i}{$matrix_value}} ){
$intersection_columns{$index_j}++ if ( $num_higher_values++ >= $min_size );
$number_of_columns_deleted++ if ( defined $intersection_columns{$index_j} and $intersection_columns{$index_j} >= $min_size );
}
}
}
if ( $verbose >= 5 ){
print "\n";
for my $i ( 0 .. $#{$matrix_ref} ) {
print " [";
for my $j ( 0 .. $#{$matrix_ref->[$i]} ) {
printf (" %${matrix_spaces}.${decimals}f", $matrix_ref->[$i]->[$j] );
if ( defined $intersection_columns{$j} and $intersection_columns{$j} == $min_size ){ print "**"; } else{ print " "; }
}
print "]\n";
}
print "\n";
}
my $idx = 0;
for my $i ( 0 .. $#{$matrix_ref} ) {
for my $j ( 0 .. $#{$matrix_ref->[$i]} ) {
undef ( $matrix_ref->[$i]->[$j] ) if ( defined $intersection_columns{$j} and $intersection_columns{$j} >= $min_size );
if ( $i == 0 and defined $intersection_columns{$j} and $intersection_columns{$j} >= $min_size ){
printf " N = $min_size ; M = $max_size ; j = %2s ; \$intersection_columns{$j} = $intersection_columns{$j} \n", $j if ( $verbose >= 5 );
}
if ( $i == 0 and ( not defined $intersection_columns{$j} or $intersection_columns{$j} < $min_size ) ){
$index_correlation{$idx} = $j;
printf " N = $min_size ; M = $max_size ; j = %2s ; \$index_correlation{$idx} = $index_correlation{$idx} \n", $j if ( $verbose >= 5 );
$idx++;
}
}
}
for my $i ( 0 .. $#{$matrix_ref} ) {
@{$matrix_ref->[$i]} = grep { defined($_) } @{$matrix_ref->[$i]};
}
if ( $verbose >= 5 ){
print "\n";
for my $i ( 0 .. $#{$matrix_ref} ) {
print " [";
for my $j ( 0 .. $#{$matrix_ref->[$i]} ) {
printf (" %${matrix_spaces}.${decimals}f ", $matrix_ref->[$i]->[$j] );
}
print "]\n";
}
print "\n";
}
$max_size = $max_size - $number_of_columns_deleted;
}
sub print_screen_messages {
my ( $matrix_ref, $matrix_index_ref, $matrix_input_ref, $output_index_ref, $optimal_benefit, $verbose, $epsilon ) = @_;
my @matrix = @$matrix_ref;
my @matrix_index = @$matrix_index_ref;
my @matrix_input = @$matrix_input_ref;
my @output_index = @$output_index_ref;
if ( $verbose >= 1 ){
print "\nObjective: ";
printf( $maximize_total_benefit ? "to Maximize the total benefit\n" : "to Minimize the total benefit\n" );
printf(" Number of left nodes: %u\n", $array1_size );
printf(" Number of right nodes: %u\n", $array2_size );
printf(" Number of edges: %u\n", $array1_size * $array2_size );
print "\nSolution:\n";
printf(" Optimal assignment: sum of values = %.${decimals}f \n", $optimal_benefit );
printf(" Feasible assignment condition: stepsize = %.4g < 1/$min_size = %.4g \n", $epsilon, 1/$min_size ) if ( $verbose >= 1 and $max_size >= 2 );
printf(" Number of iterations: %u \n", $iter_count_global ) if ( $verbose >= 1 );
print "\n row index = [";
for my $i ( 0 .. $#output_index ) {
printf("%${matrix_spaces}d ", $i);
}
print "]\n";
print " column index = [";
for my $index (@output_index) {
printf("%${matrix_spaces}d ", $index);
}
print "]\n";
print " matrix value = [";
for my $i ( 0 .. $#output_index ){
my $j = $output_index[$i];
last if not defined $j;
my $weight;
$weight = ( defined $matrix_input[$i] and defined $matrix_input[$i]->[$j] ) ? sprintf( "%${matrix_spaces}.${decimals}f ", $matrix_input[$i]->[$j] ) : ' ' x ($matrix_spaces+1) ;
print $weight;
}
print "]\n\n";
}
if ( $verbose >= 2 ){
my $index_length = length($original_max_size);
if ( $verbose >= 3 ){
printf " modified matrix %d x %d:\n", $#matrix + 1, $#{$matrix[0]} + 1;
for my $i ( 0 .. $#matrix ) {
print " [";
for my $j ( 0 .. $#{$matrix[$i]} ) {
printf(" %${matrix_spaces}.${decimals}f", $matrix[$i]->[$j] );
if ( $j == $matrix_index[$i] ){ print "**"; } else{ print " "; }
}
print "]\n";
}
print "\n";
}
print " original matrix $array1_size x $array2_size with solution:\n";
for my $i ( 0 .. $#matrix_input ) {
print " [";
for my $j ( 0 .. $#{$matrix_input[$i]} ) {
printf(" %${matrix_spaces}.${decimals}f", $matrix_input[$i]->[$j] );
if ( $j == $output_index[$i] ){ print "**"; } else{ print " "; }
}
print "]\n";
}
my %orderly_solution;
for my $i ( 0 .. $original_max_size - 1 ){
my $j = $output_index[$i];
my $weight = $max_matrix_value;
$weight = $matrix_input[$i]->[$j] if ( defined $matrix_input[$i] and defined $matrix_input[$i]->[$j] ); # condition for valid solution
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
sub get_matrix_info {
my ( $matrix_ref, $verbose ) = @_;
my @matrix = @$matrix_ref;
my $min_matrix_value;
for my $i ( 0 .. $#matrix ) {
for my $j ( 0 .. $#{$matrix[$i]} ) {
my $char_number = length( $matrix[$i]->[$j] ); # count the number of characters
$matrix_spaces = $char_number if ( (not defined $matrix_spaces) || ($char_number > $matrix_spaces) );
$max_matrix_value = $matrix[$i]->[$j] if ( (not defined $max_matrix_value) || ($matrix[$i]->[$j] > $max_matrix_value) );
$min_matrix_value = $matrix[$i]->[$j] if ( (not defined $min_matrix_value) || ($matrix[$i]->[$j] < $min_matrix_value) );
}}
$decimals = length(($max_matrix_value =~ /[,.](\d+)/)[0]); # counting the number of digits after the decimal point
$decimals = 0 unless ( defined $decimals ); # for integers $decimals = 0
my $range = $max_matrix_value - $min_matrix_value; # $range >= 0
$range = 1 if ($range == 0);
if ( $verbose >= 4 ){
print "\n min_matrix_value = $min_matrix_value ; max_matrix_value = $max_matrix_value ; range = $range ; matrix_spaces = $matrix_spaces ; decimals = $decimals \n";
}
if ( $maximize_total_benefit ){
for my $i ( 0 .. $#matrix ) {
for my $j ( 0 .. $#{$matrix[$i]} ) {
$matrix[$i]->[$j] = $matrix[$i]->[$j] - $min_matrix_value ;
#$matrix[$i]->[$j] = 99 * ( $matrix[$i]->[$j] - $min_matrix_value ) / $range; # new scale: Min = 0 <---> Max = 99
}}
} else {
for my $i ( 0 .. $#matrix ) {
for my $j ( 0 .. $#{$matrix[$i]} ) {
$matrix[$i]->[$j] = $max_matrix_value - $matrix[$i]->[$j] ;
#$matrix[$i]->[$j] = 99 * ( $max_matrix_value - $matrix[$i]->[$j] ) / $range; # new scale: Min = 0 <---> Max = 99
}}
}
}
sub auctionRound {
my ( $matrix_ref, $epsilon, $verbose ) = @_;
my @matrix = @$matrix_ref;
my ( %info, %choose_object, %count_object, %choose_person );
my %this_person_can_choose_n_different_objects;
my %objects_with_the_same_values;
my $number_of_assignned_object = scalar keys %assignned_object;
if ( $verbose >= 8 )
{
print $output "\n Start: Matrix Size N x M: $min_size x $max_size ; epsilon_scaling = $epsilon_scaling ; Number of Global Iterations = $iter_count_global ; Number of Local Iterations = $iter_count_local ; epsilon = $epsilon ; \$number_of_assignned_...
foreach my $person ( sort { $a <=> $b } keys %assignned_person ){
my $object = $assignned_person{$person};
printf $output " \$assignned_person{%3s} --> object %3s --> \$price_object{%3s} = $price_object{$object} \n", $person, $object, $object;
}
foreach my $object ( sort { $a <=> $b } keys %price_object ){
printf $output " \$price_object{%3s} = $price_object{$object} \n", $object;
}
print $output "\n";
}
my $seen_ghost;
for my $person ( 0 .. $max_size - 1 )
{
last if $seen_ghost; # don't need to fill the matrix with zeros, that is, don't need to convert rectangular N x M to square matrix by padding zeroes. Need just one more row: N+1 x M
if ( not defined $assignned_person{$person} )
{
## ------> j object 0 object 1 object 2 object 3 ... object (M - 1)
## | person 0 price_0_0 price_0_1 price_0_2 price_0_3 price_0_j
## | person 1 price_1_0
## | person 2 price_2_0
## | ...
## i person (N - 1) price_i_0
my ( $Opt01ObjForPersonI, $Opt02ObjForPersonI, $Opt03ObjForPersonI );
my ( $Opt01ValForPersonI, $Opt02ValForPersonI, $Opt03ValForPersonI ) = ( -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value) );
my ( $Opt01ObjForPersonI_new_list, $Opt02ObjForPersonI_new_list, $Opt03ObjForPersonI_new_list );
my ( $Opt01ValForPersonI_new_list, $Opt02ValForPersonI_new_list, $Opt03ValForPersonI_new_list ) = ( -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value) );
my $Opt01ValForPersonI_old_list;
my $bidForPersonI;
my %current_value;
my @updated_price;
$seen_ghost++ if ( not defined $matrix[$person] and $min_size < $max_size );
# The @objects_with_greater_benefits list are updated dynamically by $objects_desired_by_this{$person} by considering the current price (or current value) of objects.
# For each person, the Current Value $current_value{$object} of the most desired objects contained in the @objects_with_greater_benefits list tends to converge to a specific value.
my @objects_with_greater_benefits = keys %{$objects_desired_by_this{$person}}; # sort { $a <=> $b }
# There is at least one object in the @objects_with_greater_benefits list whose price is updated ? use old list : generate new list;
for my $object ( @objects_with_greater_benefits ) # use old list
{
my $matrix_value = $seen_ghost ? 0 : $matrix[$person]->[$object];
$current_value{$object} = $matrix_value - $price_object{$object};
push @updated_price, $object if ( $objects_desired_by_this{$person}{$object} == $current_value{$object} );
if ( $current_value{$object} > $Opt01ValForPersonI ) # search for the best 3 objects
{
$Opt03ValForPersonI = $Opt02ValForPersonI;
$Opt03ObjForPersonI = $Opt02ObjForPersonI;
$Opt02ValForPersonI = $Opt01ValForPersonI;
$Opt02ObjForPersonI = $Opt01ObjForPersonI;
$Opt01ValForPersonI = $current_value{$object};
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
next if ( $choose_object{$object} );
next if ( $choose_person{$person} );
my $CurVal = $objects_with_the_same_values{$object}{$person}; # $CurVal = $current_value{$object} = $Opt01ValForPersonI.
my $Opt01ObjForPersonI = $object;
$info{$Opt01ObjForPersonI}{'bid' } = $epsilon;
$info{$Opt01ObjForPersonI}{'person'} = $person;
$objects_desired_by_this{$person}{$object} = $CurVal;
if ( $verbose >= 8 ){
my @objects_with_same_values_full = sort { $a <=> $b } @{$this_person_can_choose_n_different_objects{$person}{'objects'}};
my @objects_with_same_values_free = grep { not $choose_object{$_} } @objects_with_same_values_full;
printf $output "<*** equal values ***> \$bidForPersonI = \$epsilon = %.5f ; PersonI = %3s chose ObjectJ = %3s between these (@objects_with_same_values_full) --> free (@objects_with_same_values_free) ; \$count_object{$object} = $count_object{$objec...
}
$choose_object{$object}++;
$choose_person{$person}++;
}}
foreach my $object ( keys %info ) # sort { $a <=> $b } or sort { $info{$a}{'person'} <=> $info{$b}{'person'} }
{
my $bid = $info{$object}{'bid' };
my $person = $info{$object}{'person'};
my $other_person = $assignned_object{$object}; # Find the other person who has objectJ and make them unassigned
if ( defined $other_person ) {
if ( $verbose >= 8 ){
print $output " ***--> PersonI $person was assigned objectJ $object. Before that, remove the objectJ $object from personI $other_person --> delete \$assignned_person{$other_person} \n";
}
# The other person that was assigned to objectJ at the beginning of the iteration (if any)
# is now left without an object (and becomes eligible to bid at the next iteration).
delete $assignned_person{$other_person};
}
# Each objectJ that receives one or more bids, determines the highest of these bids, increases the price_j
# to the highest bid, and gets assigned to the personI who submitted the highest bid.
$seen_assignned_objects{$object}++;
$assignned_person{$person} = $object;
$assignned_object{$object} = $person;
$price_object{$object} += $bid;
if ( $verbose >= 8 ){
printf $output " --> Assigning to personI = %3s the objectJ = %3s with highestBidForJ = %20.5f and update the price vector ; \$assignned_person{%3s} = %3s ; \$price_object{%3s} = %.5f \n", $person, $object, $bid, $person, $assignned_person{$person...
}
}
if ( $verbose >= 9 )
{
$number_of_assignned_object = scalar keys %assignned_object;
print $output "\n Final: Matrix Size N x M: $min_size x $max_size ; epsilon_scaling = $epsilon_scaling ; Number of Global Iterations = $iter_count_global ; Number of Local Iterations = $iter_count_local ; epsilon = $epsilon ; \$number_of_assignned_...
foreach my $person ( sort { $a <=> $b } keys %assignned_person ){
my $object = $assignned_person{$person};
printf $output " \$assignned_person{%3s} --> object %3s --> \$price_object{%3s} = $price_object{$object} \n", $person, $object, $object;
}
foreach my $object ( sort { $a <=> $b } keys %price_object ){
printf $output " \$price_object{%3s} = $price_object{$object} \n", $object;
}
print $output "\n";
}
}
1; # don't forget to return a true value from the file
__END__
=head1 NAME
Algorithm::Bertsekas - auction algorithm for the assignment problem.
This is a perl implementation for the auction algorithm for the asymmetric (N<=M) assignment problem.
=head1 DESCRIPTION
The assignment problem in the general form can be stated as follows:
"Given N jobs (or persons), M tasks (or objects) and the effectiveness of each job for each task,
the problem is to assign each job to one and only one task in such a way that the measure of
effectiveness is optimised (Maximised or Minimised)."
"Each assignment problem has associated with a table or matrix. Generally, the rows contain the
jobs (or persons) we wish to assign, and the columns comprise the tasks (or objects) we want them
assigned to. The numbers in the table are the costs associated with each particular assignment."
In Auction Algorithm (AA) the N persons iteratively submit the bids to M objects.
The AA take cost Matrix N×M = [aij] as an input and produce assignment as an output.
In the AA persons iteratively submit the bids to the objects which are then reassigned
to the bidders which offer them the best bid.
Another application is to find the (nearest/more distant) neighbors.
The distance between neighbors can be represented by a matrix or a weight function, for example:
1: f(i,j) = abs ($array1[i] - $array2[j])
2: f(i,j) = ($array1[i] - $array2[j]) ** 2
=head1 SYNOPSIS
### --- simple and direct application --- ###
### --- start --- ###
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
use diagnostics;
use Algorithm::Bertsekas qw(auction); # To install this modulus: 'cpan Algorithm::Bertsekas' or 'ppm install Algorithm-Bertsekas'
my @array1; my @array2;
my @input_matrix;
( run in 1.542 second using v1.01-cache-2.11-cpan-13bb782fe5a )