File Coverage

blib/lib/Data/Graph/Util.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	10	10	100.0
condition	6	8	75.0
subroutine	9	9	100.0
pod	3	3	100.0
total	77	79	97.4

package Data::Graph::Util;

our $DATE = '2019-02-14'; # DATE
our $VERSION = '0.005'; # VERSION

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(toposort is_cyclic is_acyclic);

sub _toposort {
    my $graph = shift;

    # this is the Kahn algorithm, ref:
    # https://en.wikipedia.org/wiki/Topological_sorting#Kahn.27s_algorithm

    my %in_degree;
    for my $k (keys %$graph) {
        $in_degree{$k} //= 0;
        for (@{ $graph->{$k} }) { $in_degree{$_}++ }
    }

    # collect nodes with no incoming edges (in_degree = 0)
    my @S;
    for (sort keys %in_degree) { unshift @S, $_ if $in_degree{$_} == 0 }

    my @L;
    while (@S) {
        my $n = pop @S;
        push @L, $n;
        for my $m (@{ $graph->{$n} }) {
            if (--$in_degree{$m} == 0) {
                unshift @S, $m;
            }
        }
    }

    if (@L == keys(%$graph)) {
        if (@_) {
            no warnings 'uninitialized';
            # user specifies a list to be sorted according to @L. this is like
            # Sort::ByExample but we implement it ourselves to avoid dependency.
            my %pos;
            for (0..$#L) { $pos{$L[$_]} = $_+1 }
            return (0, [
                sort { ($pos{$a} || @L+1) <=> ($pos{$b} || @L+1) } @{$_[0]}
            ]);
        } else {
            return (0, \@L);
        }
    } else {
        # there is a cycle
        return (1, \@L);
    }
}

sub toposort {
    my ($err, $res) = _toposort(@_);
    die "Can't toposort(), graph is cyclic" if $err;
    @$res;
}

sub is_cyclic {
    my ($err, $res) = _toposort(@_);
    $err;
}

sub is_acyclic {
    my ($err, $res) = _toposort(@_);
    !$err;
}

1;
# ABSTRACT: Utilities related to graph data structure

__END__