initial mst test

1 files changed, 80 insertions, 0 deletions

diff --git a/t/003-minimum-spanning-tree.t b/t/003-minimum-spanning-tree.t
new file mode 100644
index 0000000..8f34cf1
--- /dev/null
+++ b/t/003-minimum-spanning-tree.t
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 3;
+use Test::Deep;
+use Graph::Implicit;
+use List::MoreUtils qw/pairwise/;
+
+sub is_tree {
+    my ($graph, $start) = @_;
+    # a tree is an acyclic graph with E=V-1
+    my $v = keys %$graph;
+    my $e = (grep { defined } values %$graph);
+
+    VERTEX: for my $vertex (keys %$graph) {
+        next unless defined $graph->{$vertex};
+        my %visited;
+        $visited{$vertex} = 1;
+        my $iter = $vertex;
+        while (1) {
+            $iter = $graph->{$iter};
+            next VERTEX if !defined $iter;
+            return 0 if $visited{$iter};
+            $visited{$iter} = 1;
+        }
+    }
+
+    return $e == $v - 1;
+}
+
+sub pairs {
+    die "uneven list sizes" if @_ % 2 == 1;
+    my @list1 = @_;
+    my @list2 = splice @list1, @list1 / 2, @list1 / 2;
+    our ($a, $b); # dumb...
+    return pairwise { [$a, $b] } @list1, @list2;
+}
+
+my %graph = (
+    a => [pairs qw/  b c          /, qw/  9 1          /],
+    b => [pairs qw/      d   f   h/, qw/      9   1   9/],
+    c => [pairs qw/a       e     h/, qw/9       1     9/],
+    d => [pairs qw/a b c d e f g h/, qw/1 1 9 9 9 9 9 1/],
+    e => [pairs qw/    c d        /, qw/    9 9        /],
+    f => [pairs qw/               /, qw/               /],
+    g => [pairs qw/            g  /, qw/            9  /],
+    h => [pairs qw/          f g  /, qw/          9 1  /],
+);
+my %reachable = (
+    a => [qw/a b c d e f g h/],
+    b => [qw/a b c d e f g h/],
+    c => [qw/a b c d e f g h/],
+    d => [qw/a b c d e f g h/],
+    e => [qw/a b c d e f g h/],
+    f => [qw/          f    /],
+    g => [qw/            g  /],
+    h => [qw/          f g h/],
+);
+my %mst = (
+    d => {a => 'd', b => 'd', c => 'a', d => undef,
+          e => 'c', f => 'b', g => 'h', h => 'd'},
+);
+my $edge_calculator = sub {
+    my $vertex = shift;
+    return $graph{$vertex};
+};
+
+my $graph = Graph::Implicit->new($edge_calculator);
+for my $traversal (qw/prim/) {
+    for my $vertex (qw/d/) {
+        my @visited;
+        my $tree = $graph->$traversal($vertex, sub { push @visited, $_[1] });
+        cmp_bag(\@visited, $reachable{$vertex},
+                "$traversal visits each node exactly once from $vertex");
+        ok(is_tree($tree),
+           "$traversal creates a tree from $vertex");
+        cmp_deeply($tree, $mst{$vertex},
+                   "$traversal is the mst from $vertex");
+    }
+}