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