Question

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.

Problem

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 / ]
)

Answer 1

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