2

tsortこのアルゴリズムを使用して、ライブラリとその依存関係のリストを並べ替えています。依存関係で禁止されていない場合は、並べ替え順序を変更しないでください。これは、このライブラリのリストでは発生しません。

  • これ
  • それ
  • その他[あれ]
  • 事[これ]

依存関係は括弧内に指定されています。this依存関係はありthatません。otherに依存しthat、およびthingに依存しthatますthis。適用後tsort、リストを次のように出力したいと思います。

  • これ
  • それ
  • 他の
  • もの

注文に変更はありません。代わりに私が得るものは次のとおりです。

  • それ
  • 他の
  • これ
  • もの

これは依存関係の解決に関しては正しいですが、元の順序を保持できません。

これが私のコードの簡略化されたバージョンです：

#!/usr/bin/perl -w
use v5.10;

sub sortem {
    my %pairs;  # all pairs ($l, $r)
    my %npred;  # number of predecessors
    my %succ;   # list of successors

    for my $lib (@_) {
        my $name = $lib->[0];
        $pairs{$name} = {};
        $npred{$name} += 0;

        for my $dep (@{ $lib->[1] }) {
            next if exists $pairs{$name}{$dep};
            $pairs{$name}{$dep}++;
            $npred{$dep}++;
            push @{ $succ{$name} } => $dep;
        }
    }

    # create a list of nodes without predecessors
    my @list = grep {!$npred{$_}} keys %npred;
    my @ret;

    while (@list) {
        my $lib = pop @list;
        unshift @ret => $lib;
        foreach my $child (@{$succ{$lib}}) {
            push @list, $child unless --$npred{$child};
        }
    }

    if ( my @cycles = grep { $npred{$_} } @_ ) {
        die "Cycle detected between changes @cycles\n";
    }

    return @ret;
}

say for sortem(
    ['this',  []],
    ['that',  []],
    ['other', [qw(that)]],
    ['thing', [qw(that this)]],
);

元の順序を可能な限り維持するために、これをどのように変更できますか？

Perlを知らないが、実際に動作することを確認したいだけの場合は、これらの行をファイルに貼り付け、ファイルをフィードしてtsort、同じ、順序を保持しない出力を取得します。

that thing
this thing
that other
that this
4

1 に答える 1

3

最後のループを次のように書きましょう。

while (my @list = grep { !$npred{$_} } keys %npred) {
  push(@ret, @list);  # we will change this later
  for my $lib (@list) {
    delete $npred{$lib};
    for my $child ( @{ $succ{$ib} } ) {
      $npred{$child}--;
    }
  }
}

if (%npred) {
  ...we have a loop...
}

keys %npredつまり、ゼロを探すためにスイープを行っています。が要素を返さない場合は、grep処理が終了しているか、ループが発生しています。

トポロジカルソートを初期順序付けに関して安定させるには、次のように変更push(@ret, @list)します。

push(@ret, sort {...} @list);

ここ{...}で、 は初期順序を指定する比較関数です。

完全に機能する例で更新します。

use strict;
use warnings;
use Data::Dump qw/pp dd/;

my %deps = (
  # node => [ others pointing to node ]
  this => [],
  that => [],
  other => [qw/that/],
  thing => [qw/that this other/],
  yowza => [qw/that/],
);

# How to interpret %deps as a DAG:
#
# that ---> other ---+
#   |                V
#   +------------> thing
#   |                ^
#   +---> yowza      |
#                    |
# this --------------+
#
# There are two choices for the first node in the topological sort: "this" and "that".
# Once "that' has been chosen, "yowza" and "other" become available.
# Either "yowza" or "thing" will be the last node in any topological sort.

sub tsort {
  my ($deps, $order) = @_;

  # $deps is the DAG
  # $order is the preferred order of the nodes if there is a choice

  # Initialize counts and reverse links.

  my %ord;
  my %count;
  my %rdep;
  my $nnodes = scalar(keys %$deps);
  for (keys %$deps) {
    $count{$_} = 0;
    $rdep{$_} = [];
    $ord{$_} = $nnodes;
  }

  for my $n (keys %$deps) {
    $count{$n}++ for (@{ $deps->{$n} });
    push(@{$rdep{$_}}, $n) for (@{ $deps->{$n} });
  }

  for (my $i = 0; $i <= $#$order; $i++) {
    $ord{ $order->[$i] } = $i;
  }

  my @tsort;

  # pp(%$deps);
  # pp(%rdep);

  while (1) {
    # print "counts: ", pp(%count), "\n";
    my @list = grep { $count{$_} == 0 } (keys %count);
    last unless @list;
    my @ord = sort { $ord{$a} <=> $ord{$b} } @list;
    push(@tsort, @ord);
    for my $n (@list) {
      delete $count{$n};
      $count{$_}-- for (@{ $rdep{$n} });
    }
  }

  return @tsort;
}

sub main {
  my @t1 = tsort(\%deps, [qw/this that other thing yowza/]);
  print "t1: ", pp(@t1), "\n";

  my @t2 = tsort(\%deps, [qw/this that yowza other thing/]);
  print "t2: ", pp(@t2), "\n";

  my @t3 = tsort(\%deps, [qw/that this yowza other thing/]);
  print "t3: ", pp(@t3), "\n";
}

main();

出力は次のとおりです。

t1: ("this", "that", "other", "yowza", "thing")
t2: ("this", "that", "yowza", "other", "thing")
t3: ("that", "this", "yowza", "other", "thing")
于 2012-11-13T22:46:53.563 に答える