72_transitive.t   [plain text]

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");

}