view release on metacpan or  search on metacpan

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

			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
         
		$orderly_solution{ $weight } { $i } { 'index_array1' } = $i;
		$orderly_solution{ $weight } { $i } { 'index_array2' } = $j;		 
      }

      print "\n Pairs (in ascending order of matrix values):\n"; 

	  my $sum_matrix_value = 0;
	  my $sum_spaces = 2 * $matrix_spaces - 1;
      foreach my $matrix_value ( sort { $a <=> $b }  keys %orderly_solution ){
      foreach my $k ( sort { $a <=> $b } keys %{$orderly_solution{$matrix_value}} ){
     
		my $index_array1 = $orderly_solution{ $matrix_value } { $k } { 'index_array1' };
		my $index_array2 = $orderly_solution{ $matrix_value } { $k } { 'index_array2' };
	  
		$sum_matrix_value += $matrix_value if ( defined $matrix_input[$index_array1] and defined $matrix_input[$index_array1]->[$index_array2] );
	  
		my $weight = ( defined $matrix_input[$index_array1] and defined $matrix_input[$index_array1]->[$index_array2] ) ? sprintf( "%${matrix_spaces}.${decimals}f", $matrix_value ) : ' ' x $matrix_spaces ;
	  
		printf( "   indexes ( %${index_length}d, %${index_length}d ), matrix value = $weight ; sum of values = %${sum_spaces}.${decimals}f \n", $index_array1, $index_array2, $sum_matrix_value );
      }}
   }

}

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