has
tableau
=> (
is
=>
'rw'
,
isa
=>
'Piddle'
,
required
=> 1,
coerce
=> 1,
);
sub
_build_number_of_rows {
my
$self
=
shift
;
my
(
$number_of_columns
,
$number_of_rows
) = PDL::dims(
$self
->tableau );
return
$number_of_rows
- 1;
}
sub
_build_number_of_columns {
my
$self
=
shift
;
my
(
$number_of_columns
,
$number_of_rows
) = PDL::dims(
$self
->tableau );
return
$number_of_columns
- 1;
}
no
Moose;
sub
pivot {
my
$self
=
shift
;
my
$pivot_row_number
=
shift
;
my
$pivot_column_number
=
shift
;
my
$pdl_A
=
$self
->tableau;
my
$neg_one
= PDL->zeroes(1);
$neg_one
-= 1;
my
$scale_copy
=
$pdl_A
->slice(
"($pivot_column_number),($pivot_row_number)"
)->copy;
my
$scale
=
$pdl_A
->slice(
"($pivot_column_number),($pivot_row_number)"
);
my
$pivot_row
=
$pdl_A
->slice(
":,($pivot_row_number)"
);
$pivot_row
/=
$scale_copy
;
$scale
/=
$scale_copy
;
for
my
$i
( 0 ..
$self
->number_of_rows ) {
if
(
$i
!=
$pivot_row_number
) {
my
$a_ic_copy
=
$pdl_A
->slice(
"($pivot_column_number),($i)"
)->copy;
my
$a_ic
=
$pdl_A
->slice(
"($pivot_column_number),($i)"
);
my
$change_row
=
$pdl_A
->slice(
":,($i)"
);
my
$diff_term
=
$a_ic
x
$pivot_row
;
$change_row
-=
$diff_term
;
my
$tmp
=
$neg_one
x
$a_ic_copy
;
$a_ic
.=
$tmp
;
$a_ic
/=
$scale_copy
;
}
}
return
$pdl_A
;
}
sub
is_optimal {
my
$self
=
shift
;
my
$T_pdl
=
$self
->tableau;
my
$n_cols_A
=
$self
->number_of_columns - 1;
my
$number_of_rows
=
$self
->number_of_rows;
my
$basement_row
=
$T_pdl
->slice(
"0:$n_cols_A,($number_of_rows)"
);
my
@basement_row
=
$basement_row
->list;
my
@positive_profit_column_numbers
;
my
$optimal_flag
= 1;
foreach
my
$profit_coefficient
(
@basement_row
) {
if
(
$profit_coefficient
> 0 ) {
$optimal_flag
= 0;
last
;
}
}
return
$optimal_flag
;
}
sub
determine_simplex_pivot_columns {
my
$self
=
shift
;
my
@simplex_pivot_column_numbers
;
my
$n_cols_A
=
$self
->number_of_columns - 1;
my
$number_of_rows
=
$self
->number_of_rows;
my
$basement_row
=
$self
->tableau->slice(
"0:$n_cols_A,($number_of_rows)"
);
my
@basement_row
=
$basement_row
->list;
my
$column_number
= 0;
foreach
my
$profit_coefficient
(
@basement_row
) {
if
(
$profit_coefficient
> 0 ) {
push
@simplex_pivot_column_numbers
,
$column_number
;
}
$column_number
++;
}
return
@simplex_pivot_column_numbers
;
}
sub
determine_positive_ratios {
my
$self
=
shift
;
my
$pivot_column_number
=
shift
;
my
$n_rows_A
=
$self
->number_of_rows - 1;
my
$number_of_columns
=
$self
->number_of_columns;
my
$pivot_column
=
$self
->tableau->slice(
"($pivot_column_number),0:$n_rows_A"
);
my
@pivot_column
=
$pivot_column
->list;
my
$constant_column
=
$self
->tableau->slice(
"($number_of_columns),0:$n_rows_A"
);
my
@constant_column
=
$constant_column
->list;
my
$row_number
= 0;
my
@positive_ratio_row_numbers
;
my
@positive_ratios
;
foreach
my
$i
( 0 ..
$n_rows_A
) {
if
(
$pivot_column
[
$i
] > 0 ) {
push
@positive_ratios
,
(
$constant_column
[
$i
] /
$pivot_column
[
$i
] );
push
@positive_ratio_row_numbers
,
$i
;
}
}
return
( \
@positive_ratios
, \
@positive_ratio_row_numbers
);
}
sub
get_pdl {
my
$self
=
shift
;
my
$pdl
=
$self
->tableau;
my
$output
=
"$pdl"
;
return
$output
;
}
sub
current_solution {
my
$self
=
shift
;
my
@y
= @{
$self
->y_variables };
my
@u
= @{
$self
->u_variables };
my
$n_rows_A
=
$self
->number_of_rows - 1;
my
$number_of_columns
=
$self
->number_of_columns;
my
$constant_column
=
$self
->tableau->slice(
"($number_of_columns),0:$n_rows_A"
);
my
@constant_column
=
$constant_column
->list;
my
%primal_solution
;
for
my
$i
( 0 ..
$#y
) {
$primal_solution
{
$y
[
$i
]->{generic} } =
$constant_column
[
$i
];
}
my
$n_cols_A
=
$self
->number_of_columns - 1;
my
$number_of_rows
=
$self
->number_of_rows;
my
$basement_row
=
$self
->tableau->slice(
"0:$n_cols_A,($number_of_rows)"
);
my
@basement_row
=
$basement_row
->list;
my
%dual_solution
;
for
my
$j
( 0 ..
$#u
) {
$dual_solution
{
$u
[
$j
]->{generic} } =
$basement_row
[
$j
]*(-1);
}
return
(\
%primal_solution
, \
%dual_solution
);
}
__PACKAGE__->meta->make_immutable;
1;