| Subject: | Removing (unused) variables |
When using Math::LP to solve problems which changes over time, time and space are wasted on variables no longer used.
More over, the Math::LP::Solve object complains about variables not used (from the XS code which makes the messages hard to trap).
Attached is a patch to version 0.03 of Math::LP which adds support for
removing of unused variables of a LP system.
Regards,
Martin Lorensen
--- LP.pm-orig Wed Jun 18 19:36:21 2003
+++ LP.pm Fri Jun 20 20:34:01 2003
@@ -112,6 +112,72 @@
}
return $var->{col_index};
}
+sub remove_variable { # remove the variable and reassign numbers to the rest!
+ my Math::LP $this = shift;
+ my Math::LP::Variable $var = shift;
+
+ # check variable
+ $this->croak("A variable named `" . $var->{name} . "' is not registered to the LP.\n")
+ unless (exists $this->{variables}->{$var->{name}});
+ $this->croak("The variable has no col_index!")
+ unless defined $var->{col_index};
+ my $tv = $this->{variables}->{$var->id};
+ $this->croak("The variable with that name has a different col_index!")
+ if $var->{col_index} != $tv->{col_index};
+
+ # check use of variable
+ my $constr = $this->variable_in_use($var);
+ return $constr if defined $constr;
+
+ # everything is OK - remove ...
+ delete $this->{variables}->{$var->id};
+
+ # ... and renumber
+ foreach my $v (values %{$this->{variables}}) {
+ $v->{col_index} -= 1 unless $v->{col_index} < $var->{col_index};
+ }
+
+ # Ready for new use! (both if they are not the same object)
+ $var->{col_index} = undef;
+ $tv->{col_index} = undef;
+
+ return 0;
+}
+sub remove_unused_variables {
+ my Math::LP $this = shift;
+
+ my $renumber = 0;
+
+ # Remove unused
+ foreach my $v (values %{$this->{variables}}) {
+ unless (defined $this->variable_in_use($v)) {
+ $v->{col_index} = undef;
+ delete $this->{variables}->{$v->id};
+ $renumber = 1;
+ }
+ }
+
+ return unless $renumber;
+
+ # Renumber remaining (keep order)
+ my $i = 1;
+ foreach my $v (sort { $a->{col_index} <=> $b->{col_index} } values %{$this->{variables}}) {
+ $v->{col_index} = $i++;
+ }
+}
+sub variable_in_use { # check use of var
+ my Math::LP $this = shift;
+ my Math::LP::Variable $var = shift;
+
+ foreach my $constr (@{$this->{constraints}}) {
+ if (exists $constr->{lhs}->get_entries->{$var->id}) {
+ delete $constr->{lhs}->get_entries->{$var->id}
+ if $constr->{lhs}->get_entries->{$var->id}->{coeff} == 0;
+ return $constr if (exists $constr->{lhs}->get_entries->{$var->id});
+ };
+ }
+ return undef;
+}
sub add_constraint { # does what it says, implicitly adds all the variables
my Math::LP $this = shift;
my Math::LP::Constraint $constr = shift;
@@ -388,7 +454,7 @@
type => $LE,
);
$lp->add_constraint($constr);
-
+
# solve the LP and print the results
$lp->solve() or die "Could not solve the LP";
print "Optimum = ", $obj_fn->{value}, "\n";
@@ -481,13 +547,26 @@
=item add_variable($var)
-registers the variable as belonging to the LP. The C<index> field of
+registers the variable as belonging to the LP. The C<col_index> field of
the variable is set as a side effect. For this reason it is not allowed
to use 1 variable in 2 LP objects.
+=item remove_variable($var)
+
+unregisters a variable that is no longer used in the LP. The C<col_index>
+field of the variable are set to C<undef> and the remaining variables of
+the LP is renumbered to remove the "gap" (order are preserved). Returns 0
+on success or if a constraint uses the variable, the constraint is returned.
+
+=item remove_unused_variables()
+
+unregisters all variables that is no longer used in the LP. C<col_index>
+fields of the variables are set to C<undef> and the remaining variables of
+the LP is renumbered to remove the "gaps" (order are preserved).
+
=item add_constraint($constr)
-adds a Math::LP::Constraint to the LP. The C<index> field of the constraint
+adds a Math::LP::Constraint to the LP. The C<row_index> field of the constraint
is likewise set. It is thus also not allowed to use a single constraint in
more than 1 LP. All variables present in the constraint are automatically
registered.