62_bcc.t   [plain text]


use Graph;

use Test::More tests => 385;

my $N = 5;

sub prettyn {
    join('; ',
	 map { qq[@$_] }
	      sort { my @a = @$a; my @b = @$b;
		     my $c = @b <=> @a; return $c if $c;
		     while (@a && @b) {
			 $c = (shift @a) <=> (shift @b); return $c if $c;
		     }
		     return @a - @b }
	           map { [ sort { $a <=> $b } @$_ ] }
	 @{ $_[0] });
}

sub prettya {
    join('; ',
	 map { qq[@$_] }
	      sort { my @a = @$a; my @b = @$b;
		     my $c = @b <=> @a; return $c if $c;
		     while (@a && @b) {
			 $c = (shift @a) cmp (shift @b); return $c if $c;
		     }
		     return @a - @b }
	           map { [ sort @$_ ] }
	 @{ $_[0] });
}

my $g0a = Graph->new(undirected => 1);

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0a->biconnectivity;
    is("@{[sort { $a <=> $b } defined @$ap ? @$ap : ()]}", "");
    is("@{[prettyn($bc)]}", "");
    is("@{[prettyn($br)]}", "");
}

ok(!$g0a->is_biconnected);
ok(!$g0a->is_edge_connected);
ok(!$g0a->is_edge_separable);
is("@{[sort { $a <=> $b } $g0a->articulation_points]}", "");
is("@{[prettyn([$g0a->biconnected_components])]}", "");
is("@{[prettyn([$g0a->bridges])]}", "");

my $g0b = Graph->new(undirected => 1);
$g0b->add_vertex(0);

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0b->biconnectivity;
    is("@{[sort { $a <=> $b } defined @$ap ? @$ap : ()]}", "");
    is("@{[prettyn($bc)]}", "");
    is("@{[prettyn($br)]}", "");
}

ok(!$g0b->is_biconnected);
ok(!$g0b->is_edge_connected);
ok(!$g0b->is_edge_separable);
is("@{[sort { $a <=> $b } $g0b->articulation_points]}", "");
is("@{[prettyn([$g0b->biconnected_components])]}", "");
is("@{[prettyn([$g0b->bridges])]}", "");

my $g0c = Graph->new(undirected => 1);
$g0c->add_edge(qw(a b));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0c->biconnectivity;
    is("@{[sort { $a <=> $b } defined @$ap ? @$ap : ()]}", "");
    is("@{[prettya($bc)]}", "");
    is("@{[prettya($br)]}", "a b");
}

ok(!$g0c->is_biconnected);
ok(!$g0c->is_edge_connected);
ok( $g0c->is_edge_separable);
is("@{[sort $g0c->articulation_points]}", "");
is("@{[prettya([$g0c->biconnected_components])]}", "");
is("@{[prettya([$g0c->bridges])]}", "a b");

my $g0d = Graph->new(undirected => 1);
$g0d->add_edge(qw(a b));
$g0d->add_edge(qw(b c));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0d->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b");
    is("@{[prettya($bc)]}", "");
    is("@{[prettya($br)]}", "a b; b c");
}

ok(!$g0d->is_biconnected);
ok(!$g0d->is_edge_connected);
ok( $g0d->is_edge_separable);
is("@{[sort $g0d->articulation_points]}", "b");
is("@{[prettya([$g0d->biconnected_components])]}", "");
is("@{[prettya([$g0d->bridges])]}", "a b; b c");

my $g0e = Graph->new(undirected => 1);
$g0e->add_edge(qw(a b));
$g0e->add_edge(qw(b c));
$g0e->add_edge(qw(c d));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0e->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b c");
    is("@{[prettya($bc)]}", "");
    is("@{[prettya($br)]}", "a b; b c; c d");
}

ok(!$g0e->is_biconnected);
ok(!$g0e->is_edge_connected);
ok( $g0e->is_edge_separable);
is("@{[sort $g0e->articulation_points]}", "b c");
is("@{[prettya([$g0e->biconnected_components])]}", "");
is("@{[prettya([$g0e->bridges])]}", "a b; b c; c d");

my $g0f = Graph->new(undirected => 1);

$g0f->add_cycle(qw(a b c));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0f->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "");
    is("@{[prettya($bc)]}", "a b c");
    is("@{[prettya($br)]}", "");
}

ok( $g0f->is_biconnected);
ok( $g0f->is_edge_connected);
ok(!$g0f->is_edge_separable);
is("@{[sort $g0f->articulation_points]}", "");
is("@{[prettya([$g0f->biconnected_components])]}", "a b c");
is("@{[prettya([$g0f->bridges])]}", "");

my $g0g = Graph->new(undirected => 1);

$g0g->add_cycle(qw(a b c d));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0g->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "");
    is("@{[prettya($bc)]}", "a b c d");
    is("@{[prettya($br)]}", "");
}

ok( $g0g->is_biconnected);
ok( $g0g->is_edge_connected);
ok(!$g0g->is_edge_separable);
is("@{[sort $g0g->articulation_points]}", "");
is("@{[prettya([$g0g->biconnected_components])]}", "a b c d");
is("@{[prettya([$g0g->bridges])]}", "");

my $g0h = Graph->new(undirected => 1);

$g0h->add_cycle(qw(a b c));
$g0h->add_edge(qw(b d));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0h->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b");
    is("@{[prettya($bc)]}", "a b c");
    is("@{[prettya($br)]}", "b d");
}

ok(!$g0h->is_biconnected);
ok(!$g0h->is_edge_connected);
ok( $g0h->is_edge_separable);
is("@{[sort $g0h->articulation_points]}", "b");
is("@{[prettya([$g0h->biconnected_components])]}", "a b c");
is("@{[prettya([$g0h->bridges])]}", "b d");

my $g0i = Graph->new(undirected => 1);

$g0i->add_cycle(qw(a b c));
$g0i->add_edge(qw(b d));
$g0i->add_edge(qw(d e));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0i->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b d");
    is("@{[prettya($bc)]}", "a b c");
    is("@{[prettya($br)]}", "b d; d e");
}

ok(!$g0i->is_biconnected);
ok(!$g0i->is_edge_connected);
ok( $g0i->is_edge_separable);
is("@{[sort $g0i->articulation_points]}", "b d");
is("@{[prettya([$g0i->biconnected_components])]}", "a b c");
is("@{[prettya([$g0i->bridges])]}", "b d; d e");

my $g0j = Graph->new(undirected => 1);

$g0j->add_cycle(qw(a b c));
$g0j->add_cycle(qw(b d e));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0j->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b");
    is("@{[prettya($bc)]}", "a b c; b d e");
    is("@{[prettya($br)]}", "");
}

ok(!$g0j->is_biconnected);
ok( $g0j->is_edge_connected);
ok(!$g0j->is_edge_separable);
is("@{[sort $g0j->articulation_points]}", "b");
is("@{[prettya([$g0j->biconnected_components])]}", "a b c; b d e");
is("@{[prettya([$g0j->bridges])]}", "");

my $g0k = Graph->new(undirected => 1);

$g0k->add_cycle(qw(a b c));
$g0k->add_cycle(qw(d e f));
$g0k->add_edge(qw(b d));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0k->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b d");
    is("@{[prettya($bc)]}", "a b c; d e f");
    is("@{[prettya($br)]}", "b d");
}

ok(!$g0k->is_biconnected);
ok(!$g0k->is_edge_connected);
ok( $g0k->is_edge_separable);
is("@{[sort $g0k->articulation_points]}", "b d");
is("@{[prettya([$g0k->biconnected_components])]}", "a b c; d e f");
is("@{[prettya([$g0k->bridges])]}", "b d");

my $g0l = Graph->new(undirected => 1);

$g0l->add_cycle(qw(a b c));
$g0l->add_cycle(qw(d e f));
$g0l->add_cycle(qw(g h i));
$g0l->add_edge(qw(b d));
$g0l->add_edge(qw(d g));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0l->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b d g");
    is("@{[prettya($bc)]}", "a b c; d e f; g h i");
    is("@{[prettya($br)]}", "b d; d g");
}

ok(!$g0l->is_biconnected);
ok(!$g0l->is_edge_connected);
ok( $g0l->is_edge_separable);
is("@{[sort $g0l->articulation_points]}", "b d g");
is("@{[prettya([$g0l->biconnected_components])]}", "a b c; d e f; g h i");
is("@{[prettya([$g0l->bridges])]}", "b d; d g");

my $g0m = Graph->new(undirected => 1);

$g0m->add_cycle(qw(a b c));
$g0m->add_cycle(qw(b d e));
$g0m->add_cycle(qw(b h i));

for (0..$N-1) {
    my ($ap, $bc, $br) = $g0m->biconnectivity;
    is("@{[sort defined @$ap ? @$ap : ()]}", "b");
    is("@{[prettya($bc)]}", "a b c; b d e; b h i");
    is("@{[prettya($br)]}", "");
}

ok(!$g0m->is_biconnected);
ok( $g0m->is_edge_connected);
ok(!$g0m->is_edge_separable);
is("@{[sort $g0m->articulation_points]}", "b");
is("@{[prettya([$g0m->biconnected_components])]}", "a b c; b d e; b h i");
is("@{[prettya([$g0m->bridges])]}", "");

is("@{[sort $g0m->cut_vertices]}", "b");

my $g1 = Graph->new(undirected => 1);

$g1->add_cycle(qw(0 1 2 6));
$g1->add_cycle(qw(7 8 10));
$g1->add_cycle(qw(3 4 5));
$g1->add_cycle(qw(4 9 11));
$g1->add_edge(qw(11 12));
$g1->add_edge(qw(0 5));
$g1->add_edge(qw(6 7));

for (0..2*$N-1) {
    my ($ap, $bc, $br) = $g1->biconnectivity;
    is("@{[sort { $a <=> $b } @$ap]}", "0 4 5 6 7 11");
    is("@{[prettyn($bc)]}", "0 1 2 6; 3 4 5; 4 9 11; 7 8 10");
    is("@{[prettyn($br)]}", "0 5; 6 7; 11 12");
}

my $g2 = Graph->new(undirected => 1);

$g2->add_cycle(qw(a b c));
$g2->add_cycle(qw(d e f));
$g2->add_cycle(qw(f g h));
$g2->add_edge(qw(c d));
$g2->add_edge(qw(h i));
$g2->add_edge(qw(i j));
$g2->add_edge(qw(j k));

for (0..2*$N-1) {
    my ($ap, $bc, $br) = $g2->biconnectivity;
    is("@{[sort @$ap]}", "c d f h i j");
    is("@{[prettya($bc)]}", "a b c; d e f; f g h");
    is("@{[prettya($br)]}", "c d; h i; i j; j k");
}

my $g3 = Graph->new(undirected => 1);

$g3->add_path(qw(s a e i k j i));
$g3->add_path(qw(s b a f e));
$g3->add_path(qw(b f));
$g3->add_path(qw(s c g d h l));
$g3->add_path(qw(s d));
$g3->add_path(qw(c h));

for (0..2*$N-1) {
    my ($ap, $bc, $br) = $g3->biconnectivity;
    is("@{[sort @$ap]}", "e h i s");
    is("@{[prettya($bc)]}", "a b e f s; c d g h s; i j k");
    is("@{[prettya($br)]}", "e i; h l");
}

is( $g3->biconnected_components, 3 );

my $c0a = $g3->biconnected_component_by_index(0);
my $c0b = $g3->biconnected_component_by_index(0);
my $c0c = $g3->biconnected_component_by_index(0);

my $c1a = $g3->biconnected_component_by_index(1);
my $c1b = $g3->biconnected_component_by_index(1);
my $c1c = $g3->biconnected_component_by_index(1);

my $c2a = $g3->biconnected_component_by_index(2);
my $c2b = $g3->biconnected_component_by_index(2);
my $c2c = $g3->biconnected_component_by_index(2);

is( "@$c0a", "@$c0b" );
is( "@$c0a", "@$c0c" );

is( "@$c1a", "@$c1b" );
is( "@$c1a", "@$c1c" );

is( "@$c2a", "@$c2b" );
is( "@$c2a", "@$c2c" );

isnt( "@$c0a", "@$c1a" );
isnt( "@$c0a", "@$c2a" );
isnt( "@$c1a", "@$c2a" );

my @c0a = sort @$c0a;
my @c1a = sort @$c1a;
my @c2a = sort @$c2a;

ok( (grep { $_ eq 'i' } @c0a) ||
    (grep { $_ eq 'i' } @c1a) ||
    (grep { $_ eq 'i' } @c2a) );

is( $g3->biconnected_component_by_index(3), undef );

my $g3c = $g3->biconnected_graph();

is( $g3c, "a+b+e+f+s=c+d+g+h+s,i+j+k" );

ok( $g3->same_biconnected_components('a', 'b') );
ok( $g3->same_biconnected_components('a', 'b', 'e') );
ok(!$g3->same_biconnected_components('a', 'c') );
ok(!$g3->same_biconnected_components('a', 'b', 'c') );

is("@{[sort @{ $g3c->get_vertex_attribute('a+b+e+f+s', 'subvertices') }]}", "a b e f s");
is("@{[sort @{ $g3c->get_vertex_attribute('i+j+k', 'subvertices') }]}", "i j k");
is($g3c->get_vertex_attribute('i+k+j', 'subvertices'), undef);

my $d = Graph->new;

eval '$d->biconnectivity';
like($@, qr/Graph::biconnectivity: expected undirected graph, got directed/);