1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 6;
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 = (
a => {a => undef, b => 'd', c => 'a', d => 'e',
e => 'c', f => 'b', g => 'h', h => 'd'},
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} };
};
SKIP: {
my $graph = Graph::Implicit->new($edge_calculator);
skip "not implemented yet", 6 unless $graph->can('prim');
for my $traversal (qw/prim/) {
for my $vertex (keys %mst) {
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");
}
}
}
|
