如何解決Perl中的一組約束？

Question

我有下面的一組在Perl約束（只是一個樣本組約束，而不是那些我真正需要的）的：

$a < $b 
$b > $c 
$a is odd => $a in [10..18] 
$a > 0 
$c < 30 

，我需要找到一個列表($a, $b, $c)滿足的約束。我的天真的解決方案是

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(); 
} 

現在，此解決方案不保證結束，而且通常效率非常低。在Perl中有更好的方法嗎？

編輯：我需要這個隨機測試發生器，所以解決方案需要使用隨機功能，如rand()。這是完全確定的解決方案是不夠的，但如果該解決方案可以給我的可能組合的列表，我可以選擇隨機指數：

@solutions = &find_allowed_combinations(); # solutions is an array of array references 
$index = int rand($#solutions); 
($a, $b, $c) = @$solution[$index]; 

編輯2：在這裏約束是簡單與解決蠻力。但是，如果有許多變量具有大量可能的值，那麼蠻力不是一種選擇。

Answer 1

在這個優化問題的主要挑戰是在自然界中的數學。

你的目標，我可以從你的gen_abc方法的定義中推斷出來，是通過找到各種變量的邊界間隔來修剪你的搜索空間（$a,$b等）。）

最好的策略是從你的全套約束提取儘可能多的線性約束，試圖推斷出界（使用linear programming技術，見下文），然後用詳盡的（或不確定性繼續）審訊中─對修剪的變量空間進行錯誤檢測。

典型linear programming problem是以下形式：

minimize (maximize) <something> 
subject to <constraints> 

例如，給定三個變量，a，b和c，以及下面的線性約束：

<<linear_constraints>>:: 
    $a < $b 
    $b > $c 
    $a > 0 
    $c < 30 

，可以看到上部和$a,$b和$c的下限如下：

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>> 

在Perl中，您可以使用Math::LP達到此目的。

---

例

線性約束的形式是 「C eqop C1×$V1 ± C2×$V2 ± C3×$V3 ...」，其中

• eqop是<一個，>，==，>=的，<=
• $V1 ，$V2等是變量，並且
• C，C1，C2等爲常數，可能等於0

例如，給定...

$a < $b 
$b > $c 
$a > 0 
$c < 30 

...移動所有變量（以它們的係數）在不等式的左邊，以及在不等式右邊的孤立常數：

$a - $b  < 0 
    $b - $c > 0 
$a   > 0 
      $c < 30 

...和調整的限制，使得僅=，<=和>=（在）等式被使用（對於我們的變量假定離散即整數值）：

• '... < C' 變爲」。 .. < = C-1'
• '...> C' 變爲」 ...> = C + 1'

...也就是說，

$a - $b  <= -1 
    $b - $c >= 1 
$a   >= 1 
      $c <= 29 

...然後寫是這樣的：

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 

當然，上述可推廣到任意數量的變量V1，V2，...（如$a，$b，$c，$d，...），與任何係數C1,C2，...（例如-1,1,0,123等）和任何常數值C（例如-1,1,30,29等），只要您可以將約束表達式解析爲相應的矩陣表示，如：

V1 V2 V3  C 
[ C11 C12 C13 <=> C1 ] 
[ C21 C22 C23 <=> C2 ] 
[ C31 C32 C33 <=> C3 ] 
... ... ... ... ... ... 

應用到您所提供的示例，

$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 

---

注意

作爲一個側面說明，如果執行非確定性（rand基）的測試中，它可能會或可能不會保持跟蹤的好主意（例如，其中的($a,$b,$c)元組都已經被測試，以避免再次測試它們的散列），當且僅當：

• 被測試的方法比的哈希查找更昂貴的（不是這種情況用上面提供的示例代碼，但可能會或可能不會成爲您的真實代碼的問題）
• 散列不會增長到很大比例（要麼所有變量都受有限時間間隔限制，其產品是合理的數量 - 哪種情況下檢查散列大小可以指示您是否已經完全探究整個空間 - 或者您可以定期清除散列，所以至少在一段時間內你有一些碰撞檢測）
  • 最終，如果您認爲上述內容可以適用於您，則可以使用各種實現選項（包含和不包含散列）並查看是否值得實施。

Answer 2

似乎Simo::Constrain是你想要

Answer 3

一個「真正」的答案有什麼需要解析有關關係的表達和推理。除此之外，我建議使用系統的值空間遍歷，而不是隨意嘗試值。例如，

my $count = 0; 
for (my $c = 0; $c < 30 && $count < $SOMELIMIT; ++$c) { 
    # check all other constraints on only $c here 
    # next if any fail 
    for (my $b = $c + 1; $b < $UPPERLIMIT && $count < $SOMELIMIT; ++$b) { 
     # check all other constraints on only $b and $c here 
     # next if any fail 
     for (my $a = 1; $a < $b && $count < $SOMELIMIT; ++$a) { 
      #check all remaining constraints on $a, $b, and $c here 
      # next if any fail 
      # now use surviving combinations 
      ++$count; 
     } 
    } 
} 

我把變量最獨立的限制，在最外層，未來最具約束性的下一首等

至少具有這種結構就不會測試相同的組合多次（因爲隨機版本很可能會這樣做），如果你看它運行，你可能會看到模式出現，讓你縮短執行時間。

Answer 4

我不確定你會找到一個簡單的答案（雖然我想證明是錯的！）。

看來你的問題很適合genetic algorithm。功能應該易於編寫，每個滿意的約束只得1分，否則爲0。 AI::Genetic似乎是一個模塊，可以幫助你，既要編寫代碼，並瞭解你需要寫什麼。

這應該是比蠻力方法快。

Answer 5

我反而形成產生了一堆有效的列表，一個算法隨機產生或不（應該是微不足道的），把它們寫入一個文件，然後使用該文件來養活測試程序，這樣他就可以隨意挑就是了任何名單。

Answer 6

我用Data::Constraint。您編寫實現各個約束的小子例程，然後連續應用所需的所有約束。我在「動態子程序」一章中對Mastering Perl進行了一點說明。

 
use Data::Constraint; 

Data::Constraint->add_constraint(
    'a_less_than_b', 
    run   => sub { $_[1] < $_[2] }, 
    description => "a < b", 
    ); 

Data::Constraint->add_constraint(
    'b_greater_than_c', 
    run   => sub { $_[2] > $_[3] }, 
    description => "b > c", 
    ); 

Data::Constraint->add_constraint(
    'a_greater_than_0', 
    run   => sub { $_[1] > 0 }, 
    description => "a > 0", 
    ); 

Data::Constraint->add_constraint(
    'c_less_than_30', 
    run   => sub { $_[3] < 30 }, 
    description => "c < 30", 
    ); 

Data::Constraint->add_constraint(
    'a_is_odd_between_10_18', 
    run   => sub { 
     return 1 if($_[1] < 10 or $_[1] > 18); 
     return 0 unless $_[1] % 2, 
     }, 
    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 $c; 
    my $a = int rand $b; 
    return ($a, $b, $c); 
} 

這樣做，這樣意味着它很容易檢查結果，看看有什麼失敗的，而不是一個整體的失敗：

 
a = 2 | b = 4 | c = 5 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 0 | c = 2 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 0 | c = 2 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 7 | b = 14 | c = 25 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 0 | c = 29 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 0 | c = 20 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 4 | c = 22 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 4 | b = 16 | c = 28 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 22 | c = 26 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 
a = 0 | b = 3 | c = 6 
    Failed a_greater_than_0 
    Failed a_less_than_b 
    Failed b_greater_than_c 

如果你想要的東西更多的鐵桿，我Brick模塊處理約束的樹木，包括修剪和分支。這些事情對於更大的系統是有意義的，因爲大多數代碼都會設置約束對象，因此您可以混合匹配不同情況下的各種約束。如果你只有一種情況，你可能只想堅持你擁有的東西。

祝你好運，:)