use Test::More tests => 227; use Graph::Directed; use Graph::Undirected; my $g0 = Graph::Directed->new; $g0->add_edge(qw(a b)); $g0->add_edge(qw(a c)); $g0->add_edge(qw(c d)); ok(!$g0->is_transitive); my $t0 = Graph::TransitiveClosure->new($g0); ok( $t0->has_edge(qw(a a))); ok( $t0->has_edge(qw(a b))); ok( $t0->has_edge(qw(a c))); ok(!$t0->has_edge(qw(d c))); ok(!$t0->has_edge(qw(b a))); ok( $t0->has_edge(qw(b b))); ok(!$t0->has_edge(qw(b c))); ok(!$t0->has_edge(qw(b d))); ok(!$t0->has_edge(qw(c a))); ok(!$t0->has_edge(qw(c b))); ok( $t0->has_edge(qw(c c))); ok( $t0->has_edge(qw(c d))); ok(!$t0->has_edge(qw(d a))); ok(!$t0->has_edge(qw(d b))); ok(!$t0->has_edge(qw(d c))); ok( $t0->has_edge(qw(d d))); ok( $t0->is_transitive); my $r0 = Graph::TransitiveClosure->new($g0, reflexive => 0); ok(!$r0->has_edge(qw(a a))); ok( $r0->has_edge(qw(a b))); ok( $r0->has_edge(qw(a c))); ok(!$r0->has_edge(qw(d c))); ok(!$r0->has_edge(qw(b a))); ok(!$r0->has_edge(qw(b b))); ok(!$r0->has_edge(qw(b c))); ok(!$r0->has_edge(qw(b d))); ok(!$r0->has_edge(qw(c a))); ok(!$r0->has_edge(qw(c b))); ok(!$r0->has_edge(qw(c c))); ok( $r0->has_edge(qw(c d))); ok(!$r0->has_edge(qw(d a))); ok(!$r0->has_edge(qw(d b))); ok(!$r0->has_edge(qw(d c))); ok(!$r0->has_edge(qw(d d))); ok( $r0->is_transitive); my $r1 = Graph::TransitiveClosure->new($g0, reflexive => 1); ok( $r1->has_edge(qw(a a))); ok( $r1->has_edge(qw(a b))); ok( $r1->has_edge(qw(a c))); ok(!$r1->has_edge(qw(d c))); ok(!$r1->has_edge(qw(b a))); ok( $r1->has_edge(qw(b b))); ok(!$r1->has_edge(qw(b c))); ok(!$r1->has_edge(qw(b d))); ok(!$r1->has_edge(qw(c a))); ok(!$r1->has_edge(qw(c b))); ok( $r1->has_edge(qw(c c))); ok( $r1->has_edge(qw(c d))); ok(!$r1->has_edge(qw(d a))); ok(!$r1->has_edge(qw(d b))); ok(!$r1->has_edge(qw(d c))); ok( $r1->has_edge(qw(d d))); ok( $r1->is_transitive); my $g1 = Graph::Undirected->new; $g1->add_edge(qw(a b)); $g1->add_edge(qw(a c)); $g1->add_edge(qw(c d)); ok(!$g1->is_transitive); my $t1 = Graph::TransitiveClosure->new($g1); ok( $t1->has_edge(qw(a a))); ok( $t1->has_edge(qw(a b))); ok( $t1->has_edge(qw(a c))); ok( $t1->has_edge(qw(d c))); ok( $t1->has_edge(qw(b a))); ok( $t1->has_edge(qw(b b))); ok( $t1->has_edge(qw(b c))); ok( $t1->has_edge(qw(b d))); ok( $t1->has_edge(qw(c a))); ok( $t1->has_edge(qw(c b))); ok( $t1->has_edge(qw(c c))); ok( $t1->has_edge(qw(c d))); ok( $t1->has_edge(qw(d a))); ok( $t1->has_edge(qw(d b))); ok( $t1->has_edge(qw(d c))); ok( $t1->has_edge(qw(d d))); ok( $t1->is_transitive); my $g2 = Graph->new; $g2->add_weighted_edge(qw(a b 3)); $g2->add_weighted_edge(qw(b c 1)); ok(!$g2->is_transitive); my $t2 = Graph::TransitiveClosure->new($g2, path => 1); is($t2->path_length(qw(a a)), 0); is($t2->path_length(qw(a b)), 3); is($t2->path_length(qw(a c)), 4); is($t2->path_length(qw(b a)), undef); is($t2->path_length(qw(b b)), 0); is($t2->path_length(qw(b c)), 1); is($t2->path_length(qw(c a)), undef); is($t2->path_length(qw(c b)), undef); is($t2->path_length(qw(c c)), 0); is("@{[$t2->path_vertices(qw(a a))]}", ""); is("@{[$t2->path_vertices(qw(a b))]}", "a b"); is("@{[$t2->path_vertices(qw(a c))]}", "a b c"); is("@{[$t2->path_vertices(qw(b a))]}", ""); is("@{[$t2->path_vertices(qw(b b))]}", ""); is("@{[$t2->path_vertices(qw(b c))]}", "b c"); is("@{[$t2->path_vertices(qw(c a))]}", ""); is("@{[$t2->path_vertices(qw(c b))]}", ""); is("@{[$t2->path_vertices(qw(c c))]}", ""); ok( $t2->is_transitive); my $g3 = Graph->new; $g3->add_edge(qw(a b)); $g3->add_edge(qw(b c)); ok(!$g3->is_transitive); my $t3 = Graph::TransitiveClosure->new($g3, path => 1); is($t3->path_length(qw(a a)), 0); is($t3->path_length(qw(a b)), 1); is($t3->path_length(qw(a c)), 2); is($t3->path_length(qw(b a)), undef); is($t3->path_length(qw(b b)), 0); is($t3->path_length(qw(b c)), 1); is($t3->path_length(qw(c a)), undef); is($t3->path_length(qw(c b)), undef); is($t3->path_length(qw(c c)), 0); is("@{[$t3->path_vertices(qw(a a))]}", ""); is("@{[$t3->path_vertices(qw(a b))]}", "a b"); is("@{[$t3->path_vertices(qw(a c))]}", "a b c"); is("@{[$t3->path_vertices(qw(b a))]}", ""); is("@{[$t3->path_vertices(qw(b b))]}", ""); is("@{[$t3->path_vertices(qw(b c))]}", "b c"); is("@{[$t3->path_vertices(qw(c a))]}", ""); is("@{[$t3->path_vertices(qw(c b))]}", ""); is("@{[$t3->path_vertices(qw(c c))]}", ""); is($t3->path_predecessor(qw(a a)), undef); is($t3->path_predecessor(qw(a b)), "b"); is($t3->path_predecessor(qw(a c)), "b"); is($t3->path_predecessor(qw(b a)), undef); is($t3->path_predecessor(qw(b b)), undef); is($t3->path_predecessor(qw(b c)), "c"); is($t3->path_predecessor(qw(c a)), undef); is($t3->path_predecessor(qw(c b)), undef); is($t3->path_predecessor(qw(c c)), undef); ok( $t3->is_transitive); is($g3->path_length(qw(a a)), 0); is($g3->path_length(qw(a b)), 1); is($g3->path_length(qw(a c)), 2); is($g3->path_length(qw(b a)), undef); is($g3->path_length(qw(b b)), 0); is($g3->path_length(qw(b c)), 1); is($g3->path_length(qw(c a)), undef); is($g3->path_length(qw(c b)), undef); is($g3->path_length(qw(c c)), 0); is("@{[$g3->path_vertices(qw(a a))]}", ""); is("@{[$g3->path_vertices(qw(a b))]}", "a b"); is("@{[$g3->path_vertices(qw(a c))]}", "a b c"); is("@{[$g3->path_vertices(qw(b a))]}", ""); is("@{[$g3->path_vertices(qw(b b))]}", ""); is("@{[$g3->path_vertices(qw(b c))]}", "b c"); is("@{[$g3->path_vertices(qw(c a))]}", ""); is("@{[$g3->path_vertices(qw(c b))]}", ""); is("@{[$g3->path_vertices(qw(c c))]}", ""); is($g3->path_predecessor(qw(a a)), undef); is($g3->path_predecessor(qw(a b)), "b"); is($g3->path_predecessor(qw(a c)), "b"); is($g3->path_predecessor(qw(b a)), undef); is($g3->path_predecessor(qw(b b)), undef); is($g3->path_predecessor(qw(b c)), "c"); is($g3->path_predecessor(qw(c a)), undef); is($g3->path_predecessor(qw(c b)), undef); is($g3->path_predecessor(qw(c c)), undef); { # Found by Nathan Goodman. is($t3->path_vertices("a", "b"), 2); is($t3->path_vertices("a", "b"), 2); # Crashed or hung, depending. } { my $g4 = Graph::Directed->new; $g4->set_edge_attribute("a", "b", "distance", 2); $g4->set_edge_attribute("b", "c", "distance", 3); my $t4 = Graph::TransitiveClosure->new($g4, attribute_name => 'distance', path_length => 1); is($t4->path_length("a", "c"), 5); } { # Found by Nathan Goodman. use Graph::Directed; my $graph = new Graph::Directed; $graph->add_weighted_edge('a', 'b', 1); $graph->add_weighted_edge('b', 'a', 1); my $tc = new Graph::TransitiveClosure($graph, path_length => 1, path_vertices => 1); is($tc->path_length('a','a'), 0); is($tc->path_vertices('a','a'), 0); is($tc->path_length('b','b'), 0); is($tc->path_vertices('b','b'), 0); # Some extra ones. is($tc->path_length('a','b'), 1); is($tc->path_vertices('a','b'), 2); is($tc->path_length('b','a'), 1); is($tc->path_vertices('b','a'), 2); ok($tc->is_reachable('a', 'a')); ok($tc->is_reachable('a', 'b')); ok($tc->is_reachable('b', 'a')); ok($tc->is_reachable('b', 'b')); } { use Graph::Directed; my $graph = new Graph::Directed; $graph->add_edge('a', 'b'); $graph->add_edge('b', 'a'); my $tc = new Graph::TransitiveClosure($graph, path_length => 1, path_vertices => 1); is($tc->path_length('a','a'), 0); is($tc->path_vertices('a','a'), 0); is($tc->path_length('b','b'), 0); is($tc->path_vertices('b','b'), 0); is($tc->path_length('a','b'), 1); is($tc->path_vertices('a','b'), 2); is($tc->path_length('b', 'a'), 1); is($tc->path_vertices('b','a'), 2); ok($tc->is_reachable('a', 'a')); ok($tc->is_reachable('a', 'b')); ok($tc->is_reachable('b', 'a')); ok($tc->is_reachable('b', 'b')); } { # More Nathan Goodman. use Graph::Directed; my $graph = new Graph::Directed; $graph->add_weighted_edge('a', 'a', 1); my $tc = new Graph::TransitiveClosure($graph, path_length => 1, path_vertices => 1); ok($tc->is_reachable('a', 'a')); is($tc->path_length('a', 'a'), 0); is($tc->path_vertices('a', 'a'), 0); # More extra. is($tc->path_length('b','b'), undef); is($tc->path_vertices('b','b'), undef); is($tc->path_length('a','b'), undef); is($tc->path_vertices('a','b'), undef); is($tc->path_length('b', 'a'), undef); is($tc->path_vertices('b','a'), undef); is($tc->is_reachable('a', 'b'), undef); is($tc->is_reachable('b', 'a'), undef); is($tc->is_reachable('b', 'b'), undef); } # TransitiveClosure_Floyd_Warshall is just an alias for TransitiveClosure. my $t0tcfw = Graph->TransitiveClosure_Floyd_Warshall($g0); is($t0, $t0tcfw); my $t3apspfw = Graph::APSP_Floyd_Warshall($g3); is($t3, $t3apspfw); is($t3apspfw->path_length(qw(a a)), 0); is($t3apspfw->path_length(qw(a b)), 1); is($t3apspfw->path_length(qw(a c)), 2); is($t3apspfw->path_length(qw(b a)), undef); is($t3apspfw->path_length(qw(b b)), 0); is($t3apspfw->path_length(qw(b c)), 1); is($t3apspfw->path_length(qw(c a)), undef); is($t3apspfw->path_length(qw(c b)), undef); is($t3apspfw->path_length(qw(c c)), 0); is("@{[$t3apspfw->path_vertices(qw(a a))]}", ""); is("@{[$t3apspfw->path_vertices(qw(a b))]}", "a b"); is("@{[$t3apspfw->path_vertices(qw(a c))]}", "a b c"); is("@{[$t3apspfw->path_vertices(qw(b a))]}", ""); is("@{[$t3apspfw->path_vertices(qw(b b))]}", ""); is("@{[$t3apspfw->path_vertices(qw(b c))]}", "b c"); is("@{[$t3apspfw->path_vertices(qw(c a))]}", ""); is("@{[$t3apspfw->path_vertices(qw(c b))]}", ""); is("@{[$t3apspfw->path_vertices(qw(c c))]}", ""); is($t3apspfw->path_predecessor(qw(a a)), undef); is($t3apspfw->path_predecessor(qw(a b)), "b"); is($t3apspfw->path_predecessor(qw(a c)), "b"); is($t3apspfw->path_predecessor(qw(b a)), undef); is($t3apspfw->path_predecessor(qw(b b)), undef); is($t3apspfw->path_predecessor(qw(b c)), "c"); is($t3apspfw->path_predecessor(qw(c a)), undef); is($t3apspfw->path_predecessor(qw(c b)), undef); is($t3apspfw->path_predecessor(qw(c c)), undef); { # From Andras Salamon use Graph; my $g = Graph->new; $g->add_edges(qw(a b b c a d d e b f)); my $t = $g->TransitiveClosure_Floyd_Warshall; # the calling convention ok( $t->is_reachable('a', 'f')); ok(!$t->is_reachable('c', 'f')); } { # From Andras Salamon my $g = Graph->new; $g->add_edges( qw( a b b c ) ); $g->add_vertex( 'd' ); my $t0 = $g->TransitiveClosure_Floyd_Warshall(reflexive => 0); ok( $t0->has_vertex( 'a' ) ); ok(!$t0->has_vertex( 'd' ) ); my $t1 = $g->TransitiveClosure_Floyd_Warshall(reflexive => 1); ok( $t1->has_vertex( 'a' ) ); ok( $t1->has_vertex( 'd' ) ); } { # From Andras Salamon use Graph::Directed; my $g = new Graph::Directed; $g->add_edges( qw(a b b c) ); is($g->APSP_Floyd_Warshall, 'a-a,a-b,a-c,b-b,b-c,c-c'); } { # From Nathan Goodman. my $graph=new Graph::Directed; $graph->add_weighted_edge(0,1,1); $graph->add_weighted_edge(1,2,1); my $tc1=new Graph::TransitiveClosure($graph); is ("@{[sort $tc1->path_vertices(0,1)]}", "0 1"); is ("@{[sort $tc1->path_vertices(0,2)]}", "0 1 2"); is ("@{[sort $tc1->path_vertices(1,2)]}", "1 2"); my $tc2=new Graph::TransitiveClosure($graph,path_length=>1,path_vertices=>1); is ("@{[sort $tc2->path_vertices(0,1)]}", "0 1"); is ("@{[sort $tc2->path_vertices(0,2)]}", "0 1 2"); is ("@{[sort $tc2->path_vertices(1,2)]}", "1 2"); }