Perl依賴關係樹求解器

我試圖想出一個創造性的方式來確定依賴關係，因此我可以按正確的順序啓動測試的迴歸。Perl依賴關係樹求解器

例如：

a: d, e, f 

b: c, d 

c: f 

d: e

這意味着試驗「一」取決於測試「d，e和f」等的完成。

我有下面的代碼，將打印「葉」節點「e」和「f」，但我堅持如何去遍歷和打印父節點。任何提示將非常感謝。

謝謝！

my @input = ("a:d,e,f", "b:c,d", "c:f", "d:e"); 
my %Tests =(); 
my %Built =(); 

## Build Structure 
foreach my $elem (@input) { 
    my $depends = []; 
    my $target; 
    ($target,$depends) = parseData($elem); 
    $Tests{$target} = $depends; ## Setting array ref to hashkey $target  
} 


sub parseData { 
    my $data = shift; 
    my ($target, $deps) = split(/:/, $data); 
    my @deps; 
    @deps = split(/,/, $deps); 
    return ($target,\@deps); 
} 

foreach my $key (keys %Tests) { 
    doIT(\%Tests, \%Built, $key); 
} 

sub doIT { 
my ($testRef, $builtRef, $target) = @_; 
my $depends = $testRef->{$target}; 
if(exists $builtRef->{$target}) { 
    return; 
} 
if(!$depends) { 
    ## No dependency, build it 
    print "RunTest($target)\n"; 
    $builtRef->{$target}++; 
    return; 
} 

foreach my $dep (@$depends) { 
    doIT($testRef, $builtRef, $dep); 
} 
}

來源

2014-04-13 user3528108

總是有蠻力方法。我要讓別人想出一些聰明：

use strict; 
use warnings; 

my @input = ("a:d,e,f", "b:c,d", "c:f", "d:e"); 

my %children; 
my %parents; 

for (@input) { 
    my ($parent, @kids) = split /[:,]/; 
    for (@kids) { 
     $children{$parent}{$_}++; 
     $children{$_} ||= {}; 
     push @{$parents{$_}}, $parent; 
    } 
} 

my @order; 
while (my $count = scalar keys %children) { 
    while (my ($p, $k) = each %children) { 
     if (! keys %$k) { 
      push @order, $p; 
      delete $children{$p}; 
      delete $children{$_}{$p} for @{$parents{$p}}; 
     } 
    } 

    die "circular dependency exists" if $count == scalar keys %children; 
} 

print "@order";

來源

2014-04-13 03:51:26 Miller

這是整潔的方法！我不太明白下面這行代碼的作用：$ children {$ _} || = {}。你能詳細說明這實際上在做什麼嗎？謝謝！ – user3528108

'％children'在哈希結構的哈希中保存父對子關係。 '$ children {$ a_parent} {$ a_child} = 1'。由於一些元素（比如'e'和'f''沒有任何子元素，所以只要我看到一個孩子就會初始化這個結構。要查看數據結構的格式，只要'使用Data :: Dump; dd \％孩子;'在第一個'for'循環之後' – Miller

非常好，謝謝你的解釋！ – user3528108

您最好使用Graph :: Directed等圖形模塊。例如，下面給出一個滿足你的依賴排序：

use Graph::Directed; 

my $graph = Graph::Directed->new(); 

my @edges = qw(d a e a f a c b d b f c e d); 
while (my ($from, $to) = splice @edges, 0, 2) { 
    $graph->add_edge($from, $to); 
} 
my @order = $graph->toposort(); 
print "@order\n";

它產生輸出

f e c d a b

來源

2014-04-13 03:09:50

當我執行此操作時，我以相反的順序結束輸出 - 也就是說，測試總是依賴於以後的測試。所以我認爲你可能需要在使用前顛倒'$ graph-> toposort（）'的結果... –

嗯。我得到了我所顯示的輸出。確實，一些Graph :: Directed例程自從我原來使用的0.3版本以不兼容的方式改變了它們的調用序列，但是這個例子中的方法都沒有受到影響。我無法解釋爲什麼你會得到相反的順序。最新的Graph :: Directed也有一個$ graph-> topological_sort例程，它產生「e d f c b a」。 –

下面是一個使用MooX::Role::DependsOn面向對象的例子。

use feature 'say'; 

# Class (representing a 'job') that consumes MooX::Role::DependsOn: 
package Task; 
use Moo; 
with 'MooX::Role::DependsOn'; 

sub execute { 
    my ($self) = @_; 
    say "execute called for job ".$self->dependency_tag; 
} 

package main; 
# Create some objects that consume MooX::Role::DependsOn: 
my $job = {}; 
for my $jobname (qw/ A B C D E F /) { 
    $job->{$jobname} = Task->new(dependency_tag => $jobname) 
} 

# Add some dependencies: 
# A depends on D, E, F 
$job->{A}->depends_on($job->{D}, $job->{E}, $job->{F}); 
# B depends on C, D 
$job->{B}->depends_on($job->{C}, $job->{D}); 
# C depends on F 
$job->{C}->depends_on($job->{F}); 
# D depends on E 
$job->{D}->depends_on($job->{E}); 

# Resolve dependencies for an object: 
say "Object A:"; 
my @ordered = $job->{A}->dependency_schedule; 
for my $obj (@ordered) { 
    $obj->execute; 
}

來源

2014-04-14 00:06:23

Perl依賴關係樹求解器

回答

相關問題