This drawing shows a tree of parent-child relationships. It is directed, without cycles. A child can have multiple parents.
The corresponding array of arrays in Perl is:
(
[A C],
[B C],
[D F G],
[C E D],
[E J X I],
[I J]
)
The first element in each sub-array is the parent of the rest, and the number of sub-arrays is the number of nodes who have at least one child.
I want to assign a number to each node which tells which level it is on in the graph. The level should also tell whether two nodes are independent, by which I mean they are not in direct parent-child relation. The answer to this specific example should (among many other answers) be:
[A B C D E F G X I J]
[1 1 2 3 3 4 4 4 4 5]
I solution can be implemented in any language, but Perl is preferred.
Still, non of the suggested solutions seems to work for this array:
(
[ qw( Z A )],
[ qw( B D E ) ],
[ qw( A B C ) ],
[ qw( G A E )],
[ qw( L B E )]
)
as does
(
[ 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 / ]
)
Finally, I think I have solved the problem of finding correct levels, using Borodin's and ikegami's solutions (thanks guys, highly appreiciate your efforts):
#!/usr/local/perl -w
use strict;
use warnings;
use Graph::Directed;
use List::Util qw( min max );
# my @data = (
# [ qw/ M A/ ],
# [ qw/ N A X/ ],
# [ qw/ A B C / ],
# [ qw/ B D E F/ ],
# [ qw/ C F G / ],
# [ qw/ F G / ],
# [ qw/ X C G/ ],
# [ qw/ L A B /],
# [ qw/ Q M D/]
# );
# my @data = (
# [ qw( Z A )],
# [ qw( B D E ) ],
# [ qw( A B C ) ],
# [ qw( G A E )],
# [ qw( L B E )]
# );
# my @data = (
# [ 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 / ]
# );
my @data = (
[ qw/ A M B C/ ],
[ qw/ B D F C/ ],
[ qw/ D G/ ],
[ qw/ F G/ ],
[ qw/ C G/ ],
[ qw/ M G/ ],
);
sub createGraph{
my @data = @{$_[0]};
my $graph = Graph->new(directed => 1);
foreach (@data) {
my ($parent, @children) = @$_;
$graph->add_edge($parent, $_) for @children;
}
my @cycleFound = $graph->find_a_cycle;
print "$_\n" for (@cycleFound);
$graph->is_dag() or die("Graph has cycles - unable to sort\n");
$graph->is_weakly_connected() or die "Graph not weakly connected - unable to analyze\n";
return $graph;
}
sub getLevels{
my @data = @{$_[0]};
my $graph = createGraph \@data;
my @artifacts = $graph->topological_sort();
chomp @artifacts;
print "--------------------------\n";
print "Topologically sorted list: \n";
print "$_ " for @artifacts;
print "\n--------------------------\n";
print "Initial levels (longest path):\n";
my @sources = $graph->source_vertices;
my %max_levels = map { $_=>[]} @artifacts;
my @levels = ();
for my $vertex (@artifacts) {
my $path = 0;
foreach(@sources){
if(defined($graph->path_length($_, $vertex))){
if ($graph->path_length($_, $vertex) > $path){
$path = $graph->path_length($_, $vertex)
}
}
}
printf "%s - %d\n", $vertex, $path;
push @levels, $path;
push @{$max_levels{$vertex}}, $path;
}
print "--------------------------\n";
for (my $i = 0; $i < @levels; $i++){
my $parent_level = $levels[$i];
my $parent = $artifacts[$i];
for (my $j = $i+1; $j < @levels; $j++){
my $child = $artifacts[$j];
for (@data){
my ($p, @c) = @{$_};
if($parent eq $p){
my @matches = grep(/$child/, @c);
if(scalar(@matches) != 0){
$levels[$j] = 1 + $parent_level;
push @{$max_levels{$child}},$levels[$j];
$levels[$j] = max @{$max_levels{$child}};
}
}
}
}
}
print "Final levels:\n";
my %sorted = ();
for (my $i = 0; $i < @levels; $i++){
$sorted{$artifacts[$i]} = $levels[$i];
}
my @orderedList = sort { $sorted{$a} <=> $sorted{$b} } keys %sorted;
print "$sorted{$_} $_\n" for @orderedList;
print "--------------------------\n";
return \%max_levels;
}
getLevels \@data;
Output:
--------------------------
Topologically sorted list:
A M B D C F G
--------------------------
Initial levels (longest path):
A - 0
M - 1
B - 1
D - 2
C - 1
F - 2
G - 2
--------------------------
Final levels:
0 A
1 M
1 B
2 F
2 C
2 D
3 G
--------------------------