问题

Question

此图显示了父子关系树。它是指导的，没有循环。一个孩子可以有多个父母。

Perl中相应的数组数组是：

(
    [A C],
    [B C],
    [D F G],
    [C E D],
    [E J X I],
    [I J]
)

每个子数组中的第一个元素是其余子元素的父元素，子数组的数量是至少有一个子元素的节点数。

问题

我想为每个节点分配一个数字，告诉它在图表中的哪个级别。该级别还应该判断两个节点是否独立，我的意思是它们不在直接父子关系中。这个具体例子的答案应该是（在许多其他答案中）：

[A B C D E F G X I J]
[1 1 2 3 3 4 4 4 4 5]

我的解决方案可以用任何语言实现，但首选Perl。

但是，建议的解决方案似乎不适用于此阵列：

(
  [ qw( Z A   )],
  [ qw( B D E ) ],
  [ qw( A B C ) ],    
  [ qw( G A E  )],
  [ qw( L B E )]  
)

和

一样

(
  [ qw/ M A / ],
  [ qw/ N A X / ],
  [ qw/ A B C / ],
  [ qw/ B D E / ],
  [ qw/ C F G / ], 
  [ qw/ F G / ]
  [ qw/ X C / ]
)

Answer 1

Graph::Directed模块可以更简单地处理这类数据。

多个源节点使其可能更复杂（例如，如果有另一个边[Y, X]），但只要所有源都在第一级，它就可以使用。

这是一些产生您所期望的信息的代码。它假设顶层以下的所有节点都可以从第一个源节点访问，并从那里测量它们的路径长度，忽略第二个源。

use strict;
use warnings;

use feature 'say';

use Graph::Directed;

my @data = (
  [ qw/ A C / ],
  [ qw/ B C / ],
  [ qw/ D F G / ],
  [ qw/ C E D / ],
  [ qw/ E J X I / ],
  [ qw/ I J / ],
);

my $graph = Graph->new(directed => 1);

for my $item (@data) {
  my $parent = shift @$item;
  $graph->add_edge($parent, $_) for @$item;
}

my ($source) = $graph->source_vertices;

for my $vertex (sort $graph->vertices) {
  my $path;
  if ($graph->is_source_vertex($vertex)) {
    $path = 0;
  }
  else {
    $path = $graph->path_length($source, $vertex);
  }
  printf "%s - %d\n", $vertex, $path+1;
}

<强>输出

A - 1
B - 1
C - 2
D - 3
E - 3
F - 4
G - 4
I - 4
J - 4
X - 4

Answer 2

您所要做的就是找到根节点，然后进行广度优先遍历。

my %graph = map { my ($name, @children) = @$_; $name => \@children } (
    [qw( A C )],
    [qw( B C )],
    [qw( D F G )],
    [qw( C E D )],
    [qw( E J X I )],
    [qw( I J )]
);

my %non_roots = map { $_ => 1 } map @$_, values(%graph);
my @roots = grep !$non_roots{$_}, keys(%graph);

my %results;
my @todo = map [ $_ => 1 ], @roots;
while (@todo) {
   my ($name, $depth) = @{ shift(@todo) };
   next if $results{$name};

   $results{$name} = $depth;
   push @todo, map [ $_ => $depth+1 ], @{ $graph{$name} }
      if $graph{$name};
}

my @names  = sort { $results{$a} <=> $results{$b} || $a cmp $b } keys(%results);
my @depths = @results{@names};
print "@names\n@depths\n";

付出一些努力！

Answer 3

最后，我认为我已经使用Borodin和ikegami的解决方案解决了找到正确级别的问题（感谢大家，高度推荐你的努力）：

#!/usr/local/perl -w 

use strict;
use warnings;
use Graph::Directed;
use List::Util qw( min max );

# my @data = (
# [ qw/ M A/ ],
# [ qw/ N A X/ ],
# [ qw/ A B C / ],
# [ qw/ B D E F/ ],
# [ qw/ C F G / ], 
# [ qw/ F G / ],
# [ qw/ X C G/ ],
# [ qw/ L A B /],
# [ qw/ Q M D/]
# );

# my @data = (
# [ qw( Z A   )],
# [ qw( B D E ) ],
# [ qw( A B C ) ],    
# [ qw( G A E  )],
# [ qw( L B E )]  
# );

# my @data = (
# [ qw/ M A / ],
# [ qw/ N A X / ],
# [ qw/ A B C / ],
# [ qw/ B D E / ],
# [ qw/ C F G / ], 
# [ qw/ F G / ],
# [ qw/ X C / ]
# );

my @data = (
[ qw/ A M B C/ ],
[ qw/ B D F C/ ],
[ qw/ D G/ ],
[ qw/ F G/ ],
[ qw/ C G/ ],
[ qw/ M G/ ],  
);


sub createGraph{
my @data = @{$_[0]};
my $graph = Graph->new(directed => 1);

foreach (@data) {
  my ($parent, @children) = @$_;
  $graph->add_edge($parent, $_) for @children;
}

my @cycleFound = $graph->find_a_cycle;    
print "$_\n" for (@cycleFound);
$graph->is_dag() or die("Graph has cycles - unable to sort\n");
$graph->is_weakly_connected() or die "Graph not weakly connected - unable to analyze\n";  
return $graph;
}

sub getLevels{
my @data = @{$_[0]};
my $graph = createGraph \@data;

my @artifacts = $graph->topological_sort();
chomp @artifacts; 
print "--------------------------\n";
print "Topologically sorted list: \n";
print "$_ " for @artifacts;        
print "\n--------------------------\n";

print "Initial levels (longest path):\n";
my @sources = $graph->source_vertices;
my %max_levels = map { $_=>[]} @artifacts;
my @levels = ();
for my $vertex (@artifacts) {
    my $path = 0;
    foreach(@sources){
        if(defined($graph->path_length($_, $vertex))){
            if ($graph->path_length($_, $vertex) > $path){
                $path = $graph->path_length($_, $vertex)
            }
        }
    }
 printf "%s - %d\n", $vertex, $path;
 push @levels, $path;
 push @{$max_levels{$vertex}}, $path;
}
print "--------------------------\n";

for (my $i = 0; $i < @levels; $i++){ 
my $parent_level = $levels[$i];
my $parent = $artifacts[$i];                
    for (my $j = $i+1; $j < @levels; $j++){ 
        my $child = $artifacts[$j];
        for (@data){
            my ($p, @c) = @{$_};
            if($parent eq $p){
                my @matches = grep(/$child/, @c);
                if(scalar(@matches) != 0){
                    $levels[$j]  = 1 + $parent_level;
                    push @{$max_levels{$child}},$levels[$j];
                    $levels[$j] = max @{$max_levels{$child}};
                }
            }
        }
    }            
}
print "Final levels:\n";
my %sorted = ();
for (my $i = 0; $i < @levels; $i++){
    $sorted{$artifacts[$i]} = $levels[$i];
}
my @orderedList = sort { $sorted{$a} <=> $sorted{$b} } keys %sorted;
print "$sorted{$_} $_\n" for @orderedList;
print "--------------------------\n";   
return  \%max_levels;
}

getLevels \@data;

输出：

    --------------------------
    Topologically sorted list:
    A M B D C F G
    --------------------------
    Initial levels (longest path):
    A - 0
    M - 1
    B - 1
    D - 2
    C - 1
    F - 2
    G - 2
    --------------------------
    Final levels:
    0 A
    1 M
    1 B
    2 F
    2 C
    2 D
    3 G
    --------------------------

如何在给定节点关系数据结构的情况下对父子列表进行排序？

问题

3 个答案: