view release on metacpan or  search on metacpan

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

			$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 = [";