如何從多個列表中生成父子元素的有序列表？

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的子元素。因此，每個數組中沒有特定的子級次序，但是在最終結果（如下所示）中，在子級/子級之前必須有任何父級。 （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

這將是一個簡單的後序遍歷，如果它不是一個節點有多個父母的可能性。

爲了解決這個問題，最簡單的方法是爲每個節點分配一個層級級別。在這種情況下，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