Topological sort

2022-12-06 perl topological sort algorithm Eric Lippert

I run across very useful algorithms for situation where total order of a sequence is not clear in excellent article of Eric Lippert. It allows you to make sure some items go earlier than others, typically when we have some dependencies. I recently used it for sequential processing of interdependent sets of safety cutsets.

In referenced article it is implemented in javascript, I basically rewrote it into perl, so I can play with it.

use Data::Dump;

my $deps = {
    tophat      => [],
    bowtie      => ["shirt"],
    socks       => [],
    pocketwatch => ["vest"],
    vest        => ["shirt"],
    shirt       => [],
    shoes       => ["trousers", "socks"],
    cufflinks   => ["shirt"],
    gloves      => [],
    tailcoat    => ["vest"],
    underpants  => [],
    trousers    => ["underpants"],
};

dd toposort($deps);     # ["shirt", "vest", "tailcoat", "gloves", "socks", "tophat", "underpants", "trousers", "bowtie", "pocketwatch", "shoes", "cufflinks"]

# partially sort the items so dependencies are respected
sub toposort {
    my ($dependencies) = @_;

    my $dead = {};
    my $list = [];

    for my $dependency (keys %$dependencies) {
        $dead->{$dependency} = 0;
    }

    for my $dependency (keys %$dependencies) {
        visit($dependencies, $dependency, $list, $dead);
    }
    return $list;
}

sub visit {
    my ($dependencies, $dependency, $list, $dead) = @_;

    return if $dead->{$dependency};

    $dead->{$dependency} = 1;
    for my $child (@{ $dependencies->{$dependency} }) {
        visit($dependencies, $child, $list, $dead);
    }

    push @$list, $dependency;
}