Question

我正在使用tsort algorithm对库及其依赖项列表进行排序。如果依赖项不禁止它，我希望排序顺序保持不变。这个库列表不会发生这种情况：

此
那
其他[那]
东西[这个]

依赖项在括号中指定。 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

Answer 1

让我们写下你的最后一个循环：

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没有返回任何元素时，我们就完成了或者有一个循环。

使拓扑排序稳定w.r.t。一些初始排序，我们只需将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")

使用tsort算法时可以更好地保存订单吗？

1 个答案: