複数のリストから親子要素の順序付きリストを生成する方法は？

Question

私はこの問題を持っている：（Perlで例えば、または任意の他の言語）アレイの数が与えられる：各アレイ内

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

を、最初の要素は親であり、残りは、その子です。この場合、要素Aには2つの子BとCがあり、Bには3つの子D、E、Fなどがあります。この配列のセットを処理し、正しい順序を含むリストを生成したいと思います。この場合、AはとてもB及びCが来る、ルート要素であり、その後、Bの下でD、E及びFであり、そしてCの下でG及びHは、であり、Gは、要素が複数の親を持つことができることを意味子としてHを有します（ ）。結果の配列でなければなりません。

重要：：配列番号3を参照してください.HはGの前にあります。ただし、4番目の配列のGの子です。したがって、各配列には子どもの特定の順序はありませんが、最終結果（下に示すように）には、子/レンより前に親を持つ必要があります。 （A、B、C、D、E、F、G、H）または（A、C、B、D、E、F、G、H） 、D、E、F）

は、その配列を作成するためのいくつかの再帰的な方法ではなく、要件を持っていいだろう。それは、ノードが複数の親を持っている可能性のためではなかった場合、これは、単純なポストオーダートラバースだろう

Answer 1

お時間を 感謝..

これを回避するには、ティアレベルを各ノードに割り当てるのが最も簡単な方法です。この場合、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はpossiblityです。

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