Tableau_Float.pm

package Tableau_Float;
use strict;
use Math::Cephes::Fraction qw(:fract);
use HTML::TreeBuilder;
use HTML::Element;
use HTML::Table;
use CGI::FormBuilder;

my $_one    = 1;
my $neg_one = -1;

# Construct a Tucker Tableau object that contains a tucker tableau matrix
# along with print, convert, decide_pivots and make_pivot methods.
my $EMPTY_STRING = qw{};

sub new {
    my $class = $_[0];
    bless {
        _tableau           => $_[1],
        _number_of_rows    => $_[2],
        _number_of_columns => $_[3],
        _x_variables       => $EMPTY_STRING,
        _y_variables       => $EMPTY_STRING,
        _v_variables       => $EMPTY_STRING,
        _u_variables       => $EMPTY_STRING,
        _html_matrix       => $EMPTY_STRING,
        _title             => $EMPTY_STRING,
    }, $class;
}

sub pivot {

    my $self       = shift;
    my $_pivot_row = shift;
    $_pivot_row -= 1;
    my $_pivot_column = shift;
    $_pivot_column -= 1;

    # Do tucker algebra on pivot row
    my $scale =
      $_one / ( $self->{_tableau}->[$_pivot_row]->[$_pivot_column] );
    for my $j ( 0 .. $self->{_number_of_columns} ) {
        $self->{_tableau}->[$_pivot_row]->[$j] =
          $self->{_tableau}->[$_pivot_row]->[$j] * ($scale);
    }
    $self->{_tableau}->[$_pivot_row]->[$_pivot_column] = $scale;

    # Do tucker algebra elsewhere
    for my $i ( 0 .. $self->{_number_of_rows} ) {
        if ( $i != $_pivot_row ) {

            my $neg_a_ic =
              $self->{_tableau}->[$i]->[$_pivot_column] * ($neg_one);
            for my $j ( 0 .. $self->{_number_of_columns} ) {
                $self->{_tableau}->[$i]->[$j] =
                  $self->{_tableau}->[$i]->[$j] + (
                    $neg_a_ic * ( $self->{_tableau}->[$_pivot_row]->[$j] ) );
            }
            $self->{_tableau}->[$i]->[$_pivot_column] = $neg_a_ic * ($scale);
        }
    }

    # exchange variables based on $_pivot_column and $_pivot_row
    my $increasing_primal_variable = $self->{_x_variables}->[$_pivot_column];
    my $zeroeing_primal_variable   = $self->{_y_variables}->[$_pivot_row];
    $self->{_x_variables}->[$_pivot_column] = $zeroeing_primal_variable;
    $self->{_y_variables}->[$_pivot_row]    = $increasing_primal_variable;

#print "Primal variable ",  $increasing_primal_variable->{'generic'} , " became dependent (basic) and ",
#   $zeroeing_primal_variable->{'generic'}, " became independent (nonbasic)<br />";

    my $increasing_dual_variable = $self->{_v_variables}->[$_pivot_row];
    my $zeroeing_dual_variable   = $self->{_u_variables}->[$_pivot_column];
    $self->{_v_variables}->[$_pivot_row]    = $zeroeing_dual_variable;
    $self->{_u_variables}->[$_pivot_column] = $increasing_dual_variable;

#print "Dual variable ",  $increasing_dual_variable->{'generic'} , " became dependent (basic) and ",
#    $zeroeing_dual_variable->{'generic'}, " became independent (nonbasic)<br />";

}

sub get_bland_simplex_pivot_as_HTML {
    my $self = shift;
    my ( %pivot_for, $html_output );
    if ( $self->does_bland_simplex_pivot_exist ) {
        %pivot_for   = $self->get_bland_simplex_pivot;
        $html_output =
'<div class="pivot"><span class="pivot">Anti-cycling Simplex Pivot:</span><br />';
        foreach my $pivot_column ( sort keys %pivot_for ) {
            my $matrix_column = $pivot_column + 1;
            my $matrix_row    = $pivot_for{$pivot_column} + 1;
            $html_output .=
                "Bland simplex pivot found in column: "
              . $matrix_column
              . " row: "
              . $matrix_row
              . "<br />\n";
        }
        $html_output .= "</div>";
        return $html_output;
    }
    else {
        return 0;
    }
}

sub set_tableau {
    my ( $self, $session, $is_example, $tmp_path, $examples_path ) = @_;
    $self->{_session} = $session;
    my $html_tableau =
      return_html_tableau_from_file( $session, $is_example, $tmp_path,
        $examples_path );
    my $_perl_tableau_ref;
    (
        $_perl_tableau_ref,
        $self->{_number_of_rows},
        $self->{_number_of_columns}
      )
      = html_2_perl_tableau($html_tableau);

# Make each integer and rational entry a fractional object for rational arthimetic
    for my $i ( 0 .. $self->{_number_of_rows} ) {
        for my $j ( 0 .. $self->{_number_of_columns} ) {

            # Check for existing rationals indicated with "/"
            if ( $_perl_tableau_ref->[$i]->[$j] =~ m{(\-?\d+)\/(\-?\d+)} ) {
                $self->{_tableau}->[$i]->[$j] =  $1 / $2;
            }
            else {
                $self->{_tableau}->[$i]->[$j] =
                  $_perl_tableau_ref->[$i]->[$j];
            }
        }
    }

    $self->set_variable_names($html_tableau);
    $self->set_LP_title($html_tableau);
}

sub get_matrix {
    my $self = shift;
    return $self->{_tableau};
}

sub variables_as_HTML {
    my $self                     = shift;
    my @variables                = ( 'x', 'y', 'v', 'u' );
    my $variables_as_HTML_string = $EMPTY_STRING;
    foreach my $variable (@variables) {
        $variables_as_HTML_string .= qq{<div name="$variable">} . "\n";
        my $variable_pointer = '_' . $variable . '_variables';
        foreach my $var ( @{ $self->{$variable_pointer} } ) {
            $variables_as_HTML_string .= q{<var>};
            $variables_as_HTML_string .=
                qq{<span name="generic">$var->{'generic'}</span>}
              . qq{<span name="descriptive">$var->{'descriptive'}</span>};
            $variables_as_HTML_string .= qq{</var>\n};
        }
        $variables_as_HTML_string .= "</div>\n\n";
    }

    return $variables_as_HTML_string;
}

sub current_solution_as_HTML {
    my $self    = shift;
    my $session = shift;

    # Report the Current Solution as primal dependents and dual dependents.
    my @x = @{ $self->{_x_variables} };
    my @y = @{ $self->{_y_variables} };
    my @v = @{ $self->{_v_variables} };
    my @u = @{ $self->{_u_variables} };

    my $solution_state =
      $self->is_solution_optimal
      ? '<span class="optimal">Optimal</span>'
      : 'Not Optimal';

    my $solution_table = new HTML::Table(
        -border  => 0,
        -spacing => 10,
        -padding => 2,
    );

    my ( $solution_title, $primal_solution, $primal_title );

    $solution_title = "<br />Current Basic Solution - $solution_state\n";
    $solution_table->setCell( 1, 1, $solution_title );
    $solution_table->setCellClass( 1, 1, 'title_row' );
    $solution_table->setCellColSpan( 1, 1, 2 );

    $primal_title = "Dependent Primal Variables";
    $solution_table->setCell( 2, 1, $primal_title );

    for my $i ( 0 .. $#y ) {
        if ( $y[$i]->{'descriptive'} ne $EMPTY_STRING ) {
            $primal_solution .=
                $y[$i]->{'descriptive'} . " = "
              . $self->{_tableau}->[$i]->[ $self->{_number_of_columns} ]
               . "<br />\n";
        }
        else {
            $primal_solution .=
                $y[$i]->{'generic'} . " = "
              . $self->{_tableau}->[$i]->[ $self->{_number_of_columns} ]
               . "<br />\n";
        }
    }
    $solution_table->setCell( 3, 1, $primal_solution );

    #$solution_table->setCellVAlign(2,1, 'TOP');

    my ( $dual_title, $dual_solution );
    $dual_title = "Dependent Dual Variables";
    $solution_table->setCell( 2, 2, $dual_title );

    for my $j ( 0 .. $#u ) {
        my $var =
          $self->{_tableau}->[ $self->{_number_of_rows} ]->[$j] * ($neg_one);
        if ( $u[$j]->{'descriptive'} ne $EMPTY_STRING ) {
            $dual_solution .=
              $u[$j]->{'descriptive'} . " = " . $var . "<br />\n";
        }
        else {
            $dual_solution .=
              $u[$j]->{'generic'} . " = " . $var . "<br />\n";
        }
    }
    $solution_table->setCell( 3, 2, $dual_solution );
    $solution_table->setRowVAlign( 3, 'TOP' );
    my $independent_variable_notice =
"By the nature of a <i>basic solution</i>, the primal and dual independent variables	are 0.";

    #$solution_table->setCell(4,1 , $independent_variable_notice );
    #$solution_table->setCellColSpan(4, 1, 2);

    $solution_table->setRowHead(1);
    $solution_table->setRowHead(2);
    $solution_table->setRowAlign( 1, 'LEFT' );
    $solution_table->setRowAlign( 2, 'LEFT' );

    my $bland_pivot_info;
    if ( $self->get_bland_simplex_pivot_as_HTML ) {
        $bland_pivot_info = $self->get_bland_simplex_pivot_as_HTML;
        $bland_pivot_info .= $self->get_optimize_link($session);
        $solution_table->setCell( 4, 1, $bland_pivot_info );
        $solution_table->setCellColSpan( 4, 1, 2 );
        $solution_table->setRowAlign( 4, 'LEFT' );
    }

    $solution_table->setAlign('CENTER');

    return $solution_table;
}

sub set_html_matrix {
    my $self        = shift;
    my $pivot_links = shift;    # 0 = no and 1 = all and 2 = simplex pivots only
    my $session     = shift;
    my $table_width = '100';
    my $table_width_percentage = $table_width . '%';

    #-width   =>  $table_width_percentage,
    my $html_tableau = new HTML::Table(
        -border  => 0,
        -width   => $table_width_percentage,
        -spacing => 0,
        -padding => 2,
    );

    # Determine cell width based on number of columns
    my $cell_width_as_percent_of_table =
      int( $table_width / ( $self->{_number_of_columns} + 1 ) );
    $cell_width_as_percent_of_table .= '%';

# Set data into table cells and decide if a data entry should be hyperlinked to pivot program.
    my %pivot_for;
    if ( $pivot_links != 0 ) {
        %pivot_for = $self->get_bland_simplex_pivot();
    }
    foreach my $i ( 0 .. $self->{_number_of_rows} ) {
        my $row = $i + 1;
        foreach my $j ( 0 .. $self->{_number_of_columns} ) {

            if ($pivot_links != 0) {
                my $col    = $j + 1;
                my $_pivot =
                    $ENV{SCRIPT_NAME}
                  . '?session='
                  . $session
                  . '&mode=pivot&row='
                  . $row . '&col='
                  . $col;
    
                # Check to see if entry is a simplex pivot choice and hyperlink it to the pivot method.
                if (   ( $pivot_for{$j} ne undef )
                    && ( $pivot_for{$j} == $i )
                    && ( $pivot_links != 0 ) )
                {
                    my $a = HTML::Element->new(
                        'a',
                        href  => $_pivot,
                        class => 'nounderline'
                    );
                    $a->push_content( $self->{_tableau}->[$i]->[$j] );
                    my $_linked_cell = $a->as_HTML();
                    $html_tableau->setCell( $i + 1, $j + 1, $_linked_cell );
                    $html_tableau->setCellBGColor( $i + 1, $j + 1, '#cccccc' );
                }
    
                # Creat pivot link when in pivot_links = 1, i.e. all and when no in the last row or column
                # and the entry is not zero.
                elsif ($pivot_links == 1
                    && $i != $self->{_number_of_rows}
                    && $j != $self->{_number_of_columns}
                    && $self->{_tableau}->[$i]->[$j] != 0 )
                {
                    my $a = HTML::Element->new(
                        'a',
                        href  => $_pivot,
                        class => 'nounderline'
                    );
                    $a->push_content( $self->{_tableau}->[$i]->[$j]);
                    my $_linked_cell = $a->as_HTML();
                    $html_tableau->setCell( $i + 1, $j + 1, $_linked_cell );
                }
                # set css class for last row (objective function of max).
                if ( $i == $self->{_number_of_rows} ) {
                    $html_tableau->setCellClass( $i + 1, $j + 1, 'last_row' );
                }
                else {
                    $html_tableau->setCellClass( $i + 1, $j + 1, 'coefficient_cell' );
                }

                $html_tableau->setCellWidth( $i + 1, $j + 1,
                $cell_width_as_percent_of_table );
    
            }
            # handling fract and regular number cases separately.  Regular
            # numbers currently arrise from the examle input form.
            else {
                $html_tableau->setCell( $i + 1, $j + 1, $self->{_tableau}->[$i]->[$j] );
            }
        }
    }
    $html_tableau->setLastColClass('last_column') if $pivot_links != 0;
    $html_tableau->setLastCellClass('last_cell');
    $html_tableau->setClass('matrix');
    $html_tableau->setAlign('center');
    $self->{_html_matrix} = $html_tableau;
}

sub get_html_matrix {
    my $self = shift;
    return $self->{_html_matrix};
}

sub tucker_tableau_as_HTML {
    my $self                   = shift;
    my $table_width            = '100';
    my $table_width_percentage = $table_width . '%';
    my $tucker_tableau         = new HTML::Table(
        -border  => 0,
        -width   => $table_width_percentage,
        -spacing => 0,
        -padding => 2,
    );
    my $n_rows     = $self->{_number_of_rows} + 3;
    my $n_cols     = $self->{_number_of_columns} + 3;
    my $cell_width = int( $table_width / $n_cols );
    $cell_width .= '%';

    # place the x variables in the first row starting at the second column
    # place the u variables in the last row starting in the second column.
    for my $j ( 2 .. $n_cols - 2 ) {
        my $x =
            $self->{_x_variables}->[ $j - 2 ]->{'descriptive'} ne $EMPTY_STRING
          ? $self->{_x_variables}->[ $j - 2 ]->{'descriptive'}
          : $self->{_x_variables}->[ $j - 2 ]->{'generic'};
        $x =~ s{(.*?)(\d+)$}{<i>$1<sub>$2</sub></i>};

        $tucker_tableau->setCell( 1, $j, $x );
        $tucker_tableau->setCellClass( 1, $j, 'first_tucker_row' );

        my $u =
            $self->{_u_variables}->[ $j - 2 ]->{'descriptive'} ne $EMPTY_STRING
          ? $self->{_u_variables}->[ $j - 2 ]->{'descriptive'}
          : $self->{_u_variables}->[ $j - 2 ]->{'generic'};
        $u =~ s{(.*?)(\d+)$}{<i>$1<sub>$2</sub></i>};
        my $cell = "= " . $u;
        $tucker_tableau->setCell( $n_rows, $j, $cell );
        $tucker_tableau->setCellClass( $n_rows, $j, 'last_tucker_row' );
    }

    # place -1 in the first row second to last column
    $tucker_tableau->setCell( 1, $n_cols - 1, '-1' );
    $tucker_tableau->setCellClass( 1, $n_cols - 1, 'first_tucker_row' );

    # place = g in the last row second to last column
    $tucker_tableau->setCell( $n_rows, $n_cols - 1, '= <i>g</i>' );
    $tucker_tableau->setCellClass( $n_rows, $n_cols - 1, 'last_tucker_row' );

    # place the v variables in the first row starting at the second column
    # place the y variables in the last row starting in the second column.
    for my $i ( 2 .. $n_rows - 2 ) {

        my $v =
            $self->{_v_variables}->[ $i - 2 ]->{'descriptive'} ne $EMPTY_STRING
          ? $self->{_v_variables}->[ $i - 2 ]->{'descriptive'}
          : $self->{_v_variables}->[ $i - 2 ]->{'generic'};
        $v =~ s{(.*?)(\d+)$}{<i>$1<sub>$2</sub></i>};
        $tucker_tableau->setCell( $i, 1, $v );
        $tucker_tableau->setCellClass( $i, 1, 'first_tucker_column' );

        my $y =
            $self->{_y_variables}->[ $i - 2 ]->{'descriptive'} ne $EMPTY_STRING
          ? $self->{_y_variables}->[ $i - 2 ]->{'descriptive'}
          : $self->{_y_variables}->[ $i - 2 ]->{'generic'};
        $y =~ s{(.*?)(\d+)$}{<i>$1<sub>$2</sub></i>};
        my $cell = "= -" . $y;
        $tucker_tableau->setCell( $i, $n_cols, $cell );
        $tucker_tableau->setCellClass( $i, $n_cols, 'last_tucker_column' );
    }

    # place -1 in the first column second to last row
    $tucker_tableau->setCell( $n_rows - 1, 1, '-1' );
    $tucker_tableau->setCellClass( $n_rows - 1, 1, 'first_tucker_column' );

    # place = f in the last column second to last row
    $tucker_tableau->setCell( $n_rows - 1, $n_cols, '= <i>f</i>' );
    $tucker_tableau->setCellClass( $n_rows - 1, $n_cols, 'last_tucker_column' );

    # place the Augmented Matrix table
    $tucker_tableau->setCell( 2, 2, $self->{_html_matrix} );
    $tucker_tableau->setCellColSpan( 2, 2, $n_cols - 2 );
    $tucker_tableau->setCellRowSpan( 2, 2, $n_rows - 2 );

    $tucker_tableau->setClass('tucker');
    $tucker_tableau->setAlign('center');

# set fixed cell width to have proper align (look for percentage alternative for flexibility)
    for my $j ( 1 .. $n_cols ) {
        $tucker_tableau->setCellWidth( 1, $j, $cell_width );
    }

    return $tucker_tableau;

}

sub save_html_tableau_to_file {

# save matrix and variables from which we can reconstruct the full Tucker tableau
    my $self          = shift;
    my $session       = shift;
    my $is_example    = shift;
    my $tmp_path      = shift;
    my $examples_path = shift;

    # when loading new examples, make sure the $session does not conflict
    # with existing example file names.
    my $variables = $self->variables_as_HTML;
    my $session_file;
    if ($is_example) {
        $session_file = $examples_path . $session . '.html';
    }
    else {
        $session_file = $tmp_path . $session . '.html';
    }

   #my $session_file = '/home/hunter/www/html/tucker/tmp/' . $session . '.html';
    open( F, ">$session_file" )
      or die "Can't open storage file: $session_file for writing\n";
    print F '<div class="title">', $self->{_title}, "</div>\n";
    print F $self->{_html_matrix}, "\n";
    print F $variables;
    close F;

}

####---- helper subroutines
sub html_2_perl_tableau {
    my $_html_tableau = shift;
    my $page_tree     = HTML::TreeBuilder->new_from_content($_html_tableau);
    my @tables        = $page_tree->look_down( _tag => 'table' );
    my $_perl_tableau;

    # Get First Table
    my @rows = $tables[0]->look_down( _tag => 'tr' );
    my $n_rows = $#rows;
    my $n_cols;
    for my $_row ( 0 .. $n_rows ) {
        my @_cells = $rows[$_row]->look_down( _tag => 'td' );
        $n_cols = $#_cells;
        for my $_cell ( 0 .. $n_cols ) {
            $_perl_tableau->[$_row]->[$_cell] =
              $_cells[$_cell]->as_trimmed_text;
        }
    }

    return ( $_perl_tableau, $n_rows, $n_cols );
}

sub set_variable_names {

    # Stepping through each variable of each of the four
    # (primal/dual dependent/independent) categories.
    # Then each of the possibly (currently) two spans
    # for the generic and descriptive variable names.
    my $self          = shift;
    my $_html_tableau = shift;
    my $page_tree     = HTML::TreeBuilder->new_from_content($_html_tableau);
    my @divs          = $page_tree->look_down( _tag => 'div' );
    foreach my $div (@divs) {

        #print "div encountered...";
        my $variable_type                = $div->attr('name');
        my $variable_string              = '_' . $variable_type . '_variables';
        my $occurrences_of_variable_type = 0;
        my @vars                         = $div->look_down( _tag => 'var' );

        #print "var encountered...";
        foreach my $var (@vars) {
            my @spans = $var->look_down( _tag => 'span' );
            foreach my $span (@spans) {

                #print "span encounter";
                if ( $span->attr('name') eq 'generic' ) {
                    $self->{$variable_string}->[$occurrences_of_variable_type]
                      ->{'generic'} = $span->as_trimmed_text;

                    #print  $span->as_trimmed_text;
                }
                if ( $span->attr('name') eq 'descriptive' ) {
                    $self->{$variable_string}->[$occurrences_of_variable_type]
                      ->{'descriptive'} = $span->as_trimmed_text;
                }
            }

            $occurrences_of_variable_type++;

        }

    }

}

sub set_row_and_column_numbers {
    my $self = shift;

    my @rows           = @{ $self->{_tableau} };
    my $number_of_rows = @rows;
    $number_of_rows -= 1;

    #print "rows: $number_of_rows";
    $self->{_number_of_rows} = $number_of_rows;

    my @columns           = @{ $self->{_tableau}->[0] };
    my $number_of_columns = @columns;
    $number_of_columns -= 1;
    $self->{_number_of_columns} = $number_of_columns;

}

sub get_row_and_column_numbers {
    my $self = shift;
    return $self->{_number_of_rows}, $self->{_number_of_columns};
}

sub set_generic_variable_names_from_dimensions {
    my $self = shift;
    my ( @x, @y, @v, @u );
    for my $i ( 0 .. $self->{_number_of_rows} - 1 ) {
        my $tmp_num = $i + 1;
        my $y       = 'y' . $tmp_num;
        $self->{_y_variables}->[$i]->{'generic'} = $y;
        my $v = 'v' . $tmp_num;
        $self->{_v_variables}->[$i]->{'generic'} = $v;
    }
    for my $j ( 0 .. $self->{_number_of_columns} - 1 ) {
        my $tmp_num = $j + 1;
        my $x       = 'x' . $tmp_num;
        $self->{_x_variables}->[$j]->{'generic'} = $x;
        my $u = 'u' . $tmp_num;
        $self->{_u_variables}->[$j]->{'generic'} = $u;
    }
}

# set from stored html tableau
sub set_LP_title {
    my $self          = shift;
    my $_html_tableau = shift;
    my $page_tree     = HTML::TreeBuilder->new_from_content($_html_tableau);
    my $title         = $page_tree->look_down( _tag => 'title' );
#    my $title         = $page_tree->look_down( class  => 'title' );
    $self->{_title} = $title->as_trimmed_text;

}

# set from string input
sub set_title {
    my $self  = shift;
    my $title = shift;
    $self->{_title} = $title;
}

# get from string input
sub get_title {
    my $self = shift;
    return $self->{_title};
}

sub get_title_as_HTML {
    my $self   = shift;
    my $output = '<div class="title">' . $self->{_title} . "</div><br />\n";
    return $output;
}

sub return_html_tableau_from_file {

    my $session       = shift;
    my $is_example    = shift;
    my $tmp_path      = shift;
    my $examples_path = shift;
    my $session_file;
    if ($is_example) {
        $session_file = $examples_path . $session . '.html';
    }
    else {
        $session_file = $tmp_path . $session . '.html';
    }
    open( F, "$session_file" )
      or die "Can't open storage file: $session_file for reading\n";
    my $table;
    while (<F>) {
        $table .= $_;
    }
    close F;

    return ($table);
}

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

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

}

sub write_to_tied_title_hash {

    # recall the title hash is tied to a file
    my $self          = shift;
    my $example_file  = shift;
    my $problem_title = shift;
    my $titles_file   = shift;

    use Tie::File::AsHash;
    tie my %titles, 'Tie::File::AsHash', $titles_file, split => ' => '
      or die
"ERROR: Problem tying %titles: does the titles file, $titles_file have a problem? ERROR: $!";

    if ( exists $titles{$example_file} ) {

      # file name already exists, append a random number to create a unique one.
        srand;
        my $random_number = rand;
        $example_file .= "_$random_number";
    }

    # assign title to file_name
    $titles{$example_file} = $problem_title;

    # write out to file
    untie %titles;

# return the file_name in case it was changed to avoid overwriting already existing example file
    return $example_file;

#     print $hash{foo};                             # access hash value via key name
#     $hash{foo} = "bar";                         # assign new value
#     my @keys = keys %hash;                # get the keys
#     my @values = values %hash;           # ... and values
#     exists $hash{perl};                           # check for existence
#     delete $hash{baz};                           # delete line from file
#     $hash{newkey} = "perl";                  # entered at end of file
#     while (($key,$val) = each %hash)     # iterate through hash
#     untie %hash;                                    # all done

}

sub get_tied_title_hash {
    my $self        = shift;
    my $titles_file = shift;
    use Tie::File::AsHash;
    tie my %titles, 'Tie::File::AsHash', $titles_file, split => ' => '
      or die "Problem tying %titles: $!";
    my %tmp_titles = %titles;
    untie %titles;
    return \%tmp_titles;
}

sub get_example_list_as_HTML {
    my $self        = shift;
    my $titles_file = shift;
    my $hash_ref    = $self->get_tied_title_hash($titles_file);

    my $example_list = '<h1>Example Linear Programs</h1>';

    foreach my $example ( sort { $hash_ref->{$a} cmp $hash_ref->{$b} }
        keys %{$hash_ref} )
    {
        my $example_url = $ENV{SCRIPT_NAME} . '?mode=load&example=' . $example;
        my $a = HTML::Element->new( 'a', href => $example_url );
        $a->push_content( $hash_ref->{$example} );
        my $linked_example = $a->as_HTML();
        $example_list .= "$linked_example <br />";
    }

    return $example_list;
}

sub is_solution_optimal {
    my $self = shift;

# check basement row for having non-positive entries which would => optimal when in phase 2.
    my $optimal_flag = 1;
    for my $j ( 0 .. $self->{_number_of_columns}-1 ) {
        if ( $self->{_tableau}->[ $self->{_number_of_rows} ]->[$j] >
            0 )
        {
            $optimal_flag = 0;
        }
    }
    return $optimal_flag;
}

sub optimize_tableau {
    my $self = shift;

    # assume we're coming into optimization from a link
    # on a non-optimal (but feasible) tableau.  Build the
    # link as pivot mode link but indicate optimization is desired,
    # i.e. keeping pivoting until optimal.

    # NOTE: Optimization code is currently in CGI driver, tucker.cgi

}

sub get_optimize_link {
    my $self        = shift;
    my $session     = shift;
    my %bland_pivot = $self->get_bland_simplex_pivot;
    my @bland_pivot = %bland_pivot;
    my $col         = $bland_pivot[0] + 1;
    my $row         = $bland_pivot[1] + 1;
    my $url         =
        $ENV{SCRIPT_NAME}
      . '?session='
      . $session
      . '&mode=optimize&row='
      . $row . '&col='
      . $col;

    my $a = HTML::Element->new(
        'a',
        href  => $url,
        class => 'nounderline'
    );
    $a->push_content('Optimize');

    my @tableau_views = ( 'optimal only', 'all' );
    my @fields        = qw(show_tableau);
    my $form          = CGI::FormBuilder->new(
        keepextras => 1,
        method     => 'post',
        fields     => \@fields,
        action     => $url,
        submit     => 'Optimize',
        table      => { class => 'optimize_form' },

        #validate  => { augmented_matrix => 'NUM' },
    );

    $form->field(
        name    => 'show_tableau',
        options => \@tableau_views,
        value   => 'optimal only',
        label   => 'View tableau: ',
    );

    # return  $a->as_HTML(),
    return $form->render( header => 0 );
}

sub get_session {
    my $self = shift;
    return $self->{_session};
}

sub get_simplex_pivot_columns {
    my $self        = shift;
    my @EMPTY_ARRAY = ();
    my @simplex_pivot_columns;

# According to Nering and Tucker (1993) page 26
# "selected a column with a positive entry in the basement row."
# NOTE: currently I have extended the search for pivot columns to non-negatives.
# My untution indicates a pivot could still take place but no gains would be made
# when the cost is zero.  This would not lead us to optimality, but if we were
# already in an optimal state if may (should) lead to another optimal state.
# This would only apply then in the optimal case, i.e. all entries non-positive.
    for my $col_num ( 0 .. $self->{_number_of_columns} - 1 ) {
        if ( $self->{_tableau}->[ $self->{_number_of_rows} ]->[$col_num] > 0 )
        {
            push( @simplex_pivot_columns, $col_num );
        }
    }
    if (@simplex_pivot_columns) {

        #print "there is a simplex pivot column";
        return ( \@simplex_pivot_columns );
    }
    else {

        #print "there is not a simplex pivot column";
        return 0;
    }
}

sub does_bland_simplex_pivot_exist {
    my $self = shift;

    $self->get_simplex_pivot_columns ? 1 : 0;

}

sub get_bland_simplex_pivot {
    my $self = shift;

    my @simplex_pivot_columns;
    @simplex_pivot_columns = @{ $self->get_simplex_pivot_columns }
      if $self->get_simplex_pivot_columns();

    # Apply Bland Number Ranking to Colmns.
    my @column_bland_numbers;
    foreach my $col (@simplex_pivot_columns) {
        my $bland_number = $self->get_bland_number_for( 'u', $col );
        push @column_bland_numbers, $bland_number;

        #print "col $col has bland: ", $bland_number;
    }
    my @bland_column = $self->min_index( \@column_bland_numbers );
    my $bland_column = $bland_column[0];

    #print "bland column: $bland_column";
    my $bland_pivot_column = $simplex_pivot_columns[$bland_column];

# Build Ratios and Choose row(s) that yields min for the bland simplex column as a candidate pivot point.
# To be a Simplex pivot we must not consider negative entries
    my %pivot_for;
    my @ratios;
    my @ratio_rows;

    #print "Column: $possible_pivot_column\n";
    for my $row_num ( 0 .. $self->{_number_of_rows} - 1 ) {
        if ( $self->{_tableau}->[$row_num]->[$bland_pivot_column] >
            0 )
        {
            push(
                @ratios,
                    $self->{_tableau}->[$row_num]->[ $self->{_number_of_columns} ]
                    / 
                    $self->{_tableau}->[$row_num]->[$bland_pivot_column]
                  );

            # Track the rows that give ratios
            push @ratio_rows, $row_num;
        }
    }

    my $ratios_ref           = \@ratios;
    my @min_ratio_rows_index = $self->min_index($ratios_ref);

    # Apply Bland Number Ranking to Rows that tie for minimum ratio.
    my @bland_numbers;
    foreach my $min_ratio_row_index (@min_ratio_rows_index) {
        my $bland_number =
          $self->get_bland_number_for( 'y', $min_ratio_row_index );
        push @bland_numbers, $bland_number;
    }
    my @min_bland_number_index = $self->min_index( \@bland_numbers );
    my $min_bland_number_index = $min_bland_number_index[0];
    my $bland_pivot_row        =
      $ratio_rows[ $min_ratio_rows_index[$min_bland_number_index] ];
    $pivot_for{$bland_pivot_column} = $bland_pivot_row;

    @simplex_pivot_columns ? %pivot_for : 0;
}

# Given a column number (which represents a u variable) build the bland number from the generic variable name.
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'};
    $generic_name =~ m{(.)(\d+)};
    my $var       = $1;
    my $num       = $2;
    my $start_num =
        $var eq 'x' ? 1
      : $var eq 'y' ? 2
      : $var eq 'v' ? 4
      : $var eq 'u' ? 3
      : die "Variable name $var does not equal x, y, v or u";
    my $bland_number = $start_num . $num;
    return $bland_number;
}


1;