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依赖关系树求解器

回答

相关问题