I have the following set of constraints in Perl (just a sample set of constraints, not the ones I really need):
$a < $b
$b > $c
$a is odd => $a in [10..18]
$a > 0
$c < 30
And I need to find a list ($a, $b, $c)
that meet the constraints. My naive solution is
sub check_constraint {
my ($a, $b, $c) = @_;
if !($a < $b) {return 0;}
if !($b > $c) {return 0;}
if (($a % 2) && !(10 <= $a && $a <= 18)) {return 0;}
if !($a > 0) {return 0;}
if !($c < 30) {return 0;}
return 1;
}
sub gen_abc {
my $c = int rand 30;
my $b = int rand $c;
my $a = int rand $b;
return ($a, $b, $c);
}
($a, $b, $c) = &gen_abc();
while (!&check_constraint($a, $b, $c)) {
($a, $b, $c) = &gen_abc();
}
Now, this solution isn't guaranteed to end, and is pretty inefficient in general. Is there a better way to do this in Perl?
Edit: I need this for a random test generator, so the solution needs to use random functions such as rand()
. A solution that's completely deterministic isn't enough, although if that solution can give me a list of possible combinations I can select an index at random:
@solutions = &find_allowed_combinations(); # solutions is an array of array references
$index = int rand($#solutions);
($a, $b, $c) = @$solution[$index];
Edit 2: The constraints here are simple to solve with brute force. However, if there are many variables with a large range of possible values, brute force isn't an option.
$_ - The default input and pattern-searching space. @_ - Within a subroutine the array @_ contains the parameters passed to that subroutine. $" - When an array or an array slice is interpolated into a double-quoted string or a similar context such as /.../ , its elements are separated by this value.
$@ The perl syntax error message from the last eval command. If null, the last eval parsed and executed correctly (although the operations you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error "at"?)
Normally the $$ is used to print the current process ID. print $$;
The main challenge in this optimization problem is mathematical in nature.
Your goal, as I can infer from your definition of the gen_abc
method, is to prune your search space by finding bounding intervals for your various variables ($a
, $b
etc.)
The best strategy is to extract as many linear constraints from your full set of constraints, attempt to infer the bounds (using linear programming techniques, see below), then proceed with exhaustive (or non-deterministic) trial-and-error tests against a pruned variable space.
A typical linear programming problem is of the form:
minimize (maximize) <something>
subject to <constraints>
For example, given three variables, a
, b
and c
, and the following linear constraints:
<<linear_constraints>>::
$a < $b
$b > $c
$a > 0
$c < 30
You can find upper and lower bounds for $a
, $b
and $c
as follows:
lower_bound_$a = minimize $a subject to <<linear_constraints>>
upper_bound_$a = maximize $a subject to <<linear_constraints>>
lower_bound_$b = minimize $b subject to <<linear_constraints>>
upper_bound_$b = maximize $b subject to <<linear_constraints>>
lower_bound_$c = minimize $c subject to <<linear_constraints>>
upper_bound_$c = maximize $c subject to <<linear_constraints>>
In Perl you may employ Math::LP to this purpose.
EXAMPLE
A linear constraint is of the form "C eqop C1×$V1 ± C2×$V2 ± C3×$V3 ...
", where
eqop
is one of <
, >
, ==
, >=
, <=
$V1
, $V2
etc. are variables, andC
, C1
, C2
etc. are constants, possibly equal to 0.For example, given...
$a < $b
$b > $c
$a > 0
$c < 30
...move all variables (with their coefficients) to the left of the inequality, and the lone constants to the right of the inequality:
$a - $b < 0
$b - $c > 0
$a > 0
$c < 30
...and adjust the constraints so that only =
, <=
and >=
(in)equalities are used (assuming discrete i.e. integer values for our variables):
...that is,
$a - $b <= -1
$b - $c >= 1
$a >= 1
$c <= 29
...then write something like this:
use Math::LP qw(:types); # imports optimization types
use Math::LP::Constraint qw(:types); # imports constraint types
my $lp = new Math::LP;
my $a = new Math::LP::Variable(name => 'a');
my $b = new Math::LP::Variable(name => 'b');
my $c = new Math::LP::Variable(name => 'c');
my $constr1 = new Math::LP::Constraint(
lhs => make Math::LP::LinearCombination($a, 1, $b, -1), # 1*$a -1*$b
rhs => -1,
type => $LE,
);
$lp->add_constraint($constr1);
my $constr2 = new Math::LP::Constraint(
lhs => make Math::LP::LinearCombination($b, 1, $c, -1), # 1*$b -1*$c
rhs => 1,
type => $GE,
);
$lp->add_constraint($constr2);
...
my $obj_fn_a = make Math::LP::LinearCombination($a,1);
my $min_a = $lp->minimize_for($obj_fn_a);
my $max_a = $lp->maximize_for($obj_fn_a);
my $obj_fn_b = make Math::LP::LinearCombination($b,1);
my $min_b = $lp->minimize_for($obj_fn_b);
my $max_b = $lp->maximize_for($obj_fn_b);
...
# do exhaustive search over ranges for $a, $b, $c
Of course, the above can be generalized to any number of variables V1
, V2
, ... (e.g. $a
, $b
, $c
, $d
, ...), with any coefficients C1
, C2
, ... (e.g. -1, 1, 0, 123, etc.) and any constant values C
(e.g. -1, 1, 30, 29, etc.) provided you can parse the constraint expressions into a corresponding matrix representation such as:
V1 V2 V3 C
[ C11 C12 C13 <=> C1 ]
[ C21 C22 C23 <=> C2 ]
[ C31 C32 C33 <=> C3 ]
... ... ... ... ... ...
Applying to the example you have provided,
$a $b $c C
[ 1 -1 0 <= -1 ] <= plug this into a Constraint + LinearCombination
[ 0 1 -1 >= 1 ] <= plug this into a Constraint + LinearCombination
[ 1 0 0 >= 1 ] <= plug this into a Constraint + LinearCombination
[ 0 0 1 <= 29 ] <= plug this into a Constraint + LinearCombination
NOTE
As a side note, if performing non-deterministic (rand
-based) tests, it may or may not be a good idea to keep track (e.g. in a hash) of which ($a,$b,$c)
tuples have already been tested, as to avoid testing them again, if and only if:
I use Data::Constraint. You write little subroutines that implement the individual constraints then serially apply all of the constraints that you want. I talk about this a little in Mastering Perl in the "Dynamic Subroutines" chapter.
#!perl
use v5.20;
use Data::Constraint 1.121;
use experimental qw(signatures);
Data::Constraint->add_constraint(
'a_less_than_b',
run => sub ( $c, $t ) { $t->[0] < $t->[1] },
description => "a < b",
);
Data::Constraint->add_constraint(
'b_greater_than_c',
run => sub ( $c, $t ) { $t->[1] > $t->[2] },
description => "b > c",
);
Data::Constraint->add_constraint(
'a_greater_than_0',
run => sub ( $c, $t ) { $t->[0] > 0 },
description => "a > 0",
);
Data::Constraint->add_constraint(
'c_less_than_30',
run => sub ( $c, $t ) { $t->[2] < 30 },
description => "c < 30",
);
Data::Constraint->add_constraint(
'a_is_odd_between_10_18',
run => sub ( $c, $t ) {
return 0 if( $t->[0] < 10 or $t->[0] > 18 );
return 0 unless $t->[0] % 2;
return 1;
},
description => "a is odd between 10 and 18",
);
for ( 1 .. 10 ) {
my( $a, $b, $c ) = gen_abc();
print "a = $a | b = $b | c = $c\n";
foreach my $name ( Data::Constraint->get_all_names ) {
print "\tFailed $name\n"
unless Data::Constraint->get_by_name( $name )->check( [ $a, $b, $c ] ),
}
}
sub gen_abc {
my $c = int rand 30;
my $b = int rand 30;
my $a = int rand 30;
return ($a, $b, $c);
}
Doing it this way means it's easy to inspect the result to see what failed instead of an overall failure:
a = 25 | b = 11 | c = 23 Failed a_is_odd_between_10_18 Failed a_less_than_b Failed b_greater_than_c a = 17 | b = 0 | c = 9 Failed a_less_than_b Failed b_greater_than_c a = 1 | b = 5 | c = 29 Failed a_is_odd_between_10_18 Failed b_greater_than_c a = 26 | b = 21 | c = 16 Failed a_is_odd_between_10_18 Failed a_less_than_b a = 24 | b = 20 | c = 19 Failed a_is_odd_between_10_18 Failed a_less_than_b a = 27 | b = 20 | c = 12 Failed a_is_odd_between_10_18 Failed a_less_than_b a = 18 | b = 25 | c = 13 Failed a_is_odd_between_10_18 a = 26 | b = 10 | c = 11 Failed a_is_odd_between_10_18 Failed a_less_than_b Failed b_greater_than_c a = 14 | b = 27 | c = 0 Failed a_is_odd_between_10_18 a = 6 | b = 28 | c = 20 Failed a_is_odd_between_10_18
If you want something more hardcore, my Brick module handles trees of constraints, including pruning and branching. These things make sense for bigger systems where you will mix and match the various constraints for different situations since most of the code is setting up the constraint objects. If you only have your one situation, you probably just want to stick with what you have.
Good luck, :)
I am not sure you're going to find a simple answer to this (although I'd like to be proven wrong!).
It seems that your problem would be well suited for a genetic algorithm. The fitness function should be easy to write,just score 1 for each satisfied constraint, 0 otherwise. AI::Genetic seem to be a module that could help you, both to write the code and to understand what you need to write.
This should be faster than a brute force method.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With