0

この図は、親子関係のツリーを示しています。サイクルなしで指示されます。子供は複数の親を持つことができます。

Perlの対応する配列の配列は次のとおりです。

(
    [A C],
    [B C],
    [D F G],
    [C E D],
    [E J X I],
    [I J]
)

各サブ配列の最初の要素は残りの要素の親であり、サブ配列の数は少なくとも1つの子を持つノードの数です。

問題

グラフのどのレベルにあるかを示す番号を各ノードに割り当てたいと思います。レベルは、2つのノードが独立しているかどうかも示す必要があります。つまり、これらのノードは直接の親子関係にありません。この特定の例に対する答えは（他の多くの答えの中で）次のようになります。

[A B C D E F G X I J]
[1 1 2 3 3 4 4 4 4 5]

私のソリューションはどの言語でも実装できますが、Perlが推奨されます。

それでも、提案された解決策のどれもこのアレイでは機能しないようです：

(
  [ qw( Z A   )],
  [ qw( B D E ) ],
  [ qw( A B C ) ],    
  [ qw( G A E  )],
  [ qw( L B E )]  
)

のように

(
  [ 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 / ]
)
4

3 に答える 3

3

このGraph::Directedモジュールを使用すると、この種のデータの処理が簡単になります。

ソースノードが複数あると、複雑になる可能性がありますが (たとえば、別のエッジがあった場合[Y, X])、すべてのソースが最初のレベルにある限り、機能します。

これは、期待どおりの情報を生成するコードです。最上位レベルより下のすべてのノードが最初のソース ノードからアクセス可能であると想定し、そこからのパスの長さを測定し、2 番目のソースを無視します。

use strict;
use warnings;

use feature 'say';

use Graph::Directed;

my @data = (
  [ qw/ A C / ],
  [ qw/ B C / ],
  [ qw/ D F G / ],
  [ qw/ C E D / ],
  [ qw/ E J X I / ],
  [ qw/ I J / ],
);

my $graph = Graph->new(directed => 1);

for my $item (@data) {
  my $parent = shift @$item;
  $graph->add_edge($parent, $_) for @$item;
}

my ($source) = $graph->source_vertices;

for my $vertex (sort $graph->vertices) {
  my $path;
  if ($graph->is_source_vertex($vertex)) {
    $path = 0;
  }
  else {
    $path = $graph->path_length($source, $vertex);
  }
  printf "%s - %d\n", $vertex, $path+1;
}

出力

A - 1
B - 1
C - 2
D - 3
E - 3
F - 4
G - 4
I - 4
J - 4
X - 4
于 2012-06-12T16:04:30.250 に答える
1

[これは、ノードごとに、ルートからの最短経路の長さを計算します。しかし、OP は、各ルートからの最短パスの最長パスの長さを求めています。]

必要なのは、ルート ノードを見つけてから、幅優先走査を行うことだけです。

my %graph = map { my ($name, @children) = @$_; $name => \@children } (
    [qw( A C )],
    [qw( B C )],
    [qw( D F G )],
    [qw( C E D )],
    [qw( E J X I )],
    [qw( I J )]
);

my %non_roots = map { $_ => 1 } map @$_, values(%graph);
my @roots = grep !$non_roots{$_}, keys(%graph);

my %results;
my @todo = map [ $_ => 1 ], @roots;
while (@todo) {
   my ($name, $depth) = @{ shift(@todo) };
   next if $results{$name};

   $results{$name} = $depth;
   push @todo, map [ $_ => $depth+1 ], @{ $graph{$name} }
      if $graph{$name};
}

my @names  = sort { $results{$a} <=> $results{$b} || $a cmp $b } keys(%results);
my @depths = @results{@names};
print "@names\n@depths\n";
于 2012-06-12T17:41:26.543 に答える
0

最後に、Borodin と ikegami のソリューションを使用して、正しいレベルを見つける問題を解決したと思います (ありがとう、皆さんの努力に感謝します)。

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

出力：

    --------------------------
    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
    --------------------------
于 2012-06-17T11:42:59.917 に答える