如何从多个列表中生成一个有序的父子元素列表？

Question

我有这个问题：给定一些数组（例如在 Perl 或任何其他语言中）：

1. (A,B,C)
2. (B,D,E,F)
3. (C,H,G)
4. (G,H)

在每个数组中，第一个元素是父元素，其余元素是它的子元素。在这种情况下，元素 A 有两个孩子 B 和 C，B 有三个孩子 D、E 和 F 等。我想处理这组数组，并生成一个包含正确顺序的列表。在这种情况下，A是根元素，所以有B和C，那么B下面是D，E和F，C下面是G和H，G也有H作为子元素（这意味着一个元素可以有多个父元素）。这应该是结果数组。

重要提示：查看第 3 个数组，H 在 G 之前，即使它是第四个数组中 G 的子元素。所以每个数组中的children没有特定的顺序，但在最终结果中（如下图），在child/ren之前必须有任何parent。

(A,B,C,D,E,F,G,H) 或 (A,C,B,D,E,F,G,H) 或 (A,B,C,G,H, D,E,F)

如果有一些递归方式来创建该数组会很好，但不是必需的。 谢谢你的时间..

Answer 1

如果不是因为节点可能有多个父节点，这将是一个简单的后序遍历。

要解决这个问题，最简单的方法是为每个节点分配一个 tier 级别。在这种情况下，H 出现在第 3 层和第 4 层上，并且始终是所需的最高层编号。

此代码实现了该设计。

use strict;
use warnings;

my @rules = (
  [qw/ A B C / ],
  [qw/ B D E F / ],
  [qw/ C H G / ],
  [qw/ G H / ],
);

# Build the tree from the set of rules
#
my %tree;

for (@rules) {
  my ($parent, @kids) = @$_;
  $tree{$parent}{$_}++ for @kids;
}

# Find the root node. There must be exactly one node that
# doesn't appear as a child
#
my $root = do {
  my @kids = map keys %$_, values %tree;
  my %kids = map {$_ => 1} @kids;
  my @roots = grep {not exists $kids{$_}} keys %tree;
  die qq(Multiple root nodes "@roots" found) if @roots > 1;
  die qq(No root nodes found) if @roots < 1;
  $roots[0];
};

# Build a hash of nodes versus their tier level using a post-order
# traversal of the tree
#
my %tiers;
my $tier = 0;
traverse($root);

# Build the sorted list and show the result
#
my @sorted = sort { $tiers{$a} <=> $tiers{$b} } keys %tiers;
print "@sorted\n";

sub max {
  no warnings 'uninitialized';
  my ($x, $y) = @_;
  $x > $y ? $x : $y;
}

sub traverse {
  my ($parent) = @_;
  $tier++;
  my @kids = keys %{ $tree{$parent} };
  if (@kids) {
    traverse($_) for @kids;
  }
  $tiers{$parent} = max($tiers{$parent}, $tier);
  $tier--;
}

输出

A B C F E D G H

---

编辑

这作为数组的散列工作得稍微干净一些。这是重构。

use strict;
use warnings;

my @rules = (
  [qw/ A B C / ],
  [qw/ B D E F / ],
  [qw/ C H G / ],
  [qw/ G H / ],
);

# Build the tree from the set of rules
#
my %tree;

for (@rules) {
  my ($parent, @kids) = @$_;
  $tree{$parent} = \@kids;
}

# Find the root node. There must be exactly one node that
# doesn't appear as a child
#
my $root = do {
  my @kids = map @$_, values %tree;
  my %kids = map {$_ => 1} @kids;
  my @roots = grep {not exists $kids{$_}} keys %tree;
  die qq(Multiple root nodes "@roots") if @roots > 1;
  die qq(No root nodes) if @roots < 1;
  $roots[0];
};

# Build a hash of nodes versus their tier level using a post-order
# traversal of the tree
#
my %tiers;
traverse($root);

# Build the sorted list and show the result
#
my @sorted = sort { $tiers{$a} <=> $tiers{$b} } keys %tiers;
print "@sorted\n";

sub max {
  no warnings 'uninitialized';
  my ($x, $y) = @_;
  $x  > $y ? $x : $y;
}

sub traverse {

  my ($parent, $tier) = @_;
  $tier //= 1;

  my $kids = $tree{$parent};
  if ($kids) {
    traverse($_, $tier + 1) for @$kids;
  }
  $tiers{$parent} = max($tiers{$parent}, $tier);
}

输出相当于前面的解决方案，因为有多个正确的排序。请注意，A 始终是第一个，H 最后是，A C B F G D E H 是可能的。

Answer 2

这个版本也可以，但是它给了你所有正确答案的排列，所以你每次都能得到正确的结果，但它可能不像你以前的结果（除非你有很多空闲时间......：- ))。

#!/usr/bin/perl -w

use strict;
use warnings;

use Graph::Directed qw( );

my @rules = (
   [qw( A B C )],
[qw( B D E F )],
[qw( C H G )],
[qw( G H )],
);

print @rules;

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

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

$graph->is_dag()
    or die("Graph has a cycle--unable to analyze\n");
$graph->is_weakly_connected()
or die "Graph is not weakly connected--unable to analyze\n";

print join ' ', $graph->topological_sort(); # for eks A C B D G H E F