How to generate an ordered list of parent-child elements from multiple lists?

问题

I have this problem: Given a number of arrays (for example in Perl, or any other language):

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

In each array, the first element is the parent, the rest are its children. In this case, element A has two children B and C, and B has three children D, E, and F, etc. I would like to process this set of arrays, and generate a list which contains the correct order. In this case, A is the root element, so comes B and C, then under B is D, E and F, and under C is G and H, and G also has H as children (which means an element can have multiple parent). This should be the resulting array.

Important: Look at array number 3, H comes before G, even though it's a child of G in the fourth array. So there is not particular order of children in each array, but in the final result (as shown below), must have any parent before it's child/ren.

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

Would be nice to have some recursive way of creating that array, but not a requirement. Thanks for your time..

回答1:

This would be a simple post-order traversal if it wasn't for the possibility that a node has multiple parents.

To get around this, the easiest method is to assign a tier level to each node. In this case H appears on both tiers 3 and 4, and it is always the highest tier number that is required.

This code implements that design.

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

output

A B C F E D G H

Edit

This works slightly more cleanly as a hash of arrays. Here is that refactor.

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);
}

The output is equivalent to the previous solution, given that there are multiple correct orderings. Note that A will always be first and H last, and A C B F G D E H is a possiblity.

回答2:

This version also works, but it gives you a permutation of all correct answers, so you get correct result each time, but it may not be as your previous result (unless you have a lot of spare time...:-)).

#!/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

来源：https://stackoverflow.com/questions/10320398/how-to-generate-an-ordered-list-of-parent-child-elements-from-multiple-lists

标签

perl

list

parent-child