view release on metacpan or  search on metacpan

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

sub get_bland_number_for {
    my $self          = shift;
    my $variable_type = shift;
    my $variables     = $variable_type . '_variables';
    my $index         = shift;
    my $generic_name  = $self->$variables->[$index]->{'generic'};

    my ($var, $num);
    if ($generic_name =~ m{(.)(\d+)}mxs) {
        $var = $1;
        $num = $2;
    }
    else {
        croak "The generic variable names have format issues.\n";
    }
    my $start_num =
        $var eq 'x' ? 1
      : $var eq 'y' ? 2
      : $var eq 'v' ? 4
      : $var eq 'u' ? 3
      :               croak "Variable name: $var does not equal x, y, v or u";
    my $bland_number = $start_num . $num;
    return $bland_number;
}

=head2 determine_bland_pivot_column_number

Find the pivot column using Bland ordering technique to prevent cycles.

=cut

sub determine_bland_pivot_column_number {
    my ($self, @simplex_pivot_column_numbers) = @_;

    my @bland_number_for_simplex_pivot_column;
    foreach my $col_number (@simplex_pivot_column_numbers) {
        push @bland_number_for_simplex_pivot_column,
          $self->get_bland_number_for('x', $col_number);
    }

# Pass blands number to routine that returns index of location where minimum bland occurs.
# Use this index to return the bland column column number from @positive_profit_column_numbers
    my @bland_column_number_index =
      $self->min_index(\@bland_number_for_simplex_pivot_column);
    my $bland_column_number_index = $bland_column_number_index[0];

    return $simplex_pivot_column_numbers[$bland_column_number_index];
}

=head2 determine_bland_pivot_row_number

Find the pivot row using Bland ordering technique to prevent cycles.

=cut

sub determine_bland_pivot_row_number {
    my ($self, $positive_ratios, $positive_ratio_row_numbers) = @_;

    # Now that we have the ratios and their respective rows we can find the min
    # and then select the lowest bland min if there are ties.
    my @min_indices = $self->min_index($positive_ratios);
    my @min_ratio_row_numbers =
      map { $positive_ratio_row_numbers->[$_] } @min_indices;
    my @bland_number_for_min_ratio_rows;
    foreach my $row_number (@min_ratio_row_numbers) {
        push @bland_number_for_min_ratio_rows,
          $self->get_bland_number_for('y', $row_number);
    }

# Pass blands number to routine that returns index of location where minimum bland occurs.
# Use this index to return the bland row number.
    my @bland_min_ratio_row_index =
      $self->min_index(\@bland_number_for_min_ratio_rows);
    my $bland_min_ratio_row_index = $bland_min_ratio_row_index[0];
    return $min_ratio_row_numbers[$bland_min_ratio_row_index];
}

=head2 min_index

Determine the index of the element with minimal value.  
Used when finding bland pivots.

=cut

sub min_index {
    my ($self, $l) = @_;
    my $n = @{$l};
    if (!$n) {
        return ();
    }
    my $v_min = $l->[0];
    my @i_min = (0);

    for my $i (1 .. $n - 1) {
        if ($l->[$i] < $v_min) {
            $v_min = $l->[$i];
            @i_min = ($i);
        }
        elsif ($l->[$i] == $v_min) {
            push @i_min, $i;
        }
    }
    return @i_min;

}

=head2 exchange_pivot_variables

Exchange the variables when a pivot is done.  The method pivot() does the
algrebra while this method does the variable swapping, and thus tracking of 
what variables take on non-zero values.  This is needed to accurately report
an optimal solution.

=cut

sub exchange_pivot_variables {
    my $self                = shift;
    my $pivot_row_number    = shift;
    my $pivot_column_number = shift;