Algorithm-Bertsekas

 view release on metacpan or  search on metacpan

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

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 = ();
	

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

		$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 "  "; }

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

	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;

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

      
      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);

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

	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";
	}

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

		$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";
	}