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

此图显示了父子关系树。它是定向的，没有周期。一个孩子可以有多个父母

Perl中对应的数组是：

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

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

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

I解决方案可以用任何语言实现，但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 / ]
)

该模块将使处理此类数据变得更简单

多个源节点可能会使其更加复杂（例如，如果存在另一个边缘

[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

该模块将使处理此类数据变得更简单

多个源节点可能会使其更加复杂（例如，如果存在另一个边缘

[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

[这将为每个节点计算来自根的最短路径的长度。但OP需要来自每个根的最长路径的长度。]

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

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

my%graph=map{my（$name，@children）=@$\uz；$name=>\@children}(
[qw（AC）]，
[qw（B C）]，
[qw（dfg）]，
[qw（C E D）]，
[qw（E J X I）]，
[qw（I J）]
);
我的%non_roots=map{$\=>1}map@$\u，值（%graph）；
我的@roots=grep$非_根{$}，键（%graph）；
我的%结果；
my@todo=map[$\u=>1]，@roots；
while（@todo）{
我的（$name，$depth）=@{shift（@todo）}；
下一个if$results{$name}；
$results{$name}=$depth；
推送@todo，映射[$\=>$depth+1]，@{$graph{$name}
如果$graph{$name}；
}
my@names=sort{$results{$a}$results{$b}| |$a cmp$b}键（%results）；
我的@depth=@results{@names}；
打印“@名称\n@depths\n”；

[这将为每个节点计算从根开始的最短路径的长度。但OP需要从每个根开始的最长路径的长度。]

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

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

my%graph=map{my（$name，@children）=@$\uz；$name=>\@children}(
[qw（AC）]，
[qw（B C）]，
[qw（dfg）]，
[qw（C E D）]，
[qw（E J X I）]，
[qw（I J）]
);
我的%non_roots=map{$\=>1}map@$\u，值（%graph）；
我的@roots=grep$非_根{$}，键（%graph）；
我的%结果；
my@todo=map[$\u=>1]，@roots；
while（@todo）{
我的（$name，$depth）=@{shift（@todo）}；
下一个if$results{$name}；
$results{$name}=$depth；
推送@todo，映射[$\=>$depth+1]，@{$graph{$name}
如果$graph{$name}；
}
my@names=sort{$results{$a}$results{$b}| |$a cmp$b}键（%results）；
我的@depth=@results{@names}；
打印“@名称\n@depths\n”；

最后，我想我已经用Borodin和ikegami的解决方案解决了寻找正确水平的问题（感谢各位，高度赞赏你们的努力）：

---

最后，我想我已经用Borodin和ikegami的解决方案解决了寻找正确水平的问题（感谢各位，高度赞赏你们的努力）：

---

---

像

（[ab]，[ba]）这样的图怎么样？节点列表是否总是按“深度”排序？这只是广度优先遍历。你尝试过什么？@ikegami:这不仅仅是一个简单的遍历，因为它有多个根。@Borodin，识别根很简单，一旦你这么做，它就是一个简单的广度优先搜索。@ikegami:但我们知道没有限制，所有根都在同一个级别上。想象另一条边[Y，X]或[M，C，J]那么像
（[ab]，[ba]）
这样的图呢？节点列表是否总是按“深度”排序？这只是广度优先遍历。你尝试过什么？@ikegami:这不仅仅是一个简单的遍历，因为它有多个根。@Borodin，识别根很简单，一旦你这么做，它就是一个简单的广度优先搜索。@ikegami:但我们知道没有限制，所有根都在同一个级别上。想象另一条边[Y，X]或[M，C，J]只是一件事；为什么需要“排序$图形->顶点”？谢谢你的解决方案，除了这个，很容易理解。这个解决方案不适用于我刚才在问题部分提到的阵列。找出问题所在的任何方法。我知道，它是一个复杂得多的数组。
$graph->vertices
返回图形中所有顶点的列表（
a
，
B
，
C
，
D
等），没有特定的顺序。调用
sort
将它们按字母顺序排列，只是为了保持整洁，并以与问题相同的顺序呈现它们。您的问题可能就是我看到的多个源节点的问题。检查
$graph->source\u顶点
，查看有多少个顶点。你有什么问题？：我只是在问题说明中放了两个数组，解决方案对它们不起作用。可能有一个解决办法，通过先做