u_ng_mst.t   [plain text]

use Test::More qw/no_plan/;

=head1 NAME

Test program for Graph.

=head2 SYNOPSIS

   perl u_ng_mst.t [ A [ D [ N ] ] ]

=head2 DESCRIPTION

This program constructs various trees, embeds them in general graphs,
and tests various minimum spanning tree methods: MST_Kruskal,
MST_Prim, MST_Dijkstra.

A is arity and it defaults to 4.
D is depth and it defaults to 3.
N is chain/star size and it defaults to 40.  (The minimum is 10.)
(To use a default, specify '-'.)

=head1 AUTHOR

Nathan Goodman

=cut

my ($A, $D, $N) = @ARGV;

$A = 3  if ($A || 0) < 1;
$D = 4  if ($D || 0) < 1;
$N = 40 if ($N || 0) < 1;

use strict;
use Graph;
use Graph::Directed;
use Graph::Undirected;

for my $arity (1..$A) {
  for my $depth (1..$D) {
    print "# depth=$depth, arity=$arity\n";
    #  $g=construct(new Graph::Directed,$depth,$arity);
    my $h=construct(new Graph::Undirected,$depth,$arity);
    my $t=regular_tree(new Graph::Undirected,$depth,$arity);
    my $mst1=$h->MST_Kruskal;
    is($mst1,$t,"Kruskal");
    my $mst2=$h->MST_Prim;
    is($mst2,$t,"Prim");
    my $mst3=$h->MST_Dijkstra;
    is($mst3,$t,"Dijkstra");
    #  ok(1,"end of tests for depth=$depth, arity=$arity");
  }
}
# do some long chains 
my $arity=1;
for(my $depth=10;$depth<=$N;$depth+=10) {
  print "# depth=$depth, arity=$arity\n";
  #  $g=construct(new Graph::Directed,$depth,$arity);
  my $h=construct(new Graph::Undirected,$depth,$arity);
  my $t=regular_tree(new Graph::Undirected,$depth,$arity);
  my $mst1=$h->MST_Kruskal;
  is($mst1,$t,"Kruskal");
  my $mst2=$h->MST_Prim;
  is($mst2,$t,"Prim");
  my $mst3=$h->MST_Dijkstra;
  is($mst3,$t,"Dijkstra");
  #  ok(1,"end of tests for depth=$depth, arity=$arity");
}
# do some wide stars
my $depth=1;
for(my $arity=10;$arity<=$N;$arity+=10) {
  print "# depth=$depth, arity=$arity\n";
  #  $g=construct(new Graph::Directed,$depth,$arity);
  my $h=construct(new Graph::Undirected,$depth,$arity);
  my $t=regular_tree(new Graph::Undirected,$depth,$arity);
  my $mst1=$h->MST_Kruskal;
  is($mst1,$t,"Kruskal");
  my $mst2=$h->MST_Prim;
  is($mst2,$t,"Prim");
  my $mst3=$h->MST_Dijkstra;
  is($mst3,$t,"Dijkstra");
  #  ok(1,"end of tests for depth=$depth, arity=$arity");
}

exit;

sub construct {
  my($g, $depth, $arity, $density)=@_;
  $density or $density=3;

  # make a tree with edge weights of1
  $g=regular_tree($g,$depth,$arity);
  # add heavier edges
  my @nodes=$g->vertices;
  my $new_edges=int $density*@nodes;
  for (1..$new_edges) {
    my $i=int rand $#nodes;
    my $j=int rand $#nodes;
    next if $g->has_edge($nodes[$i],$nodes[$j]);
    $g->add_weighted_edge($nodes[$i],$nodes[$j],2);
  }
  print "# V = ", scalar $g->vertices, ", E = ", scalar $g->edges, "\n";
  return $g;
}

sub regular_tree {
  my($tree,$depth,$arity,$root)=@_;
  defined $root or do {
    $root=0;
    $tree->add_vertex($root);
  };
  if ($depth>0) {
    for (my $i=0; $i<$arity; $i++) {
      my $child="$root/$i";
      $tree->add_vertex($child);
      $tree->add_weighted_edge($root,$child,1);
      regular_tree($tree,$depth-1,$arity,$child);
    }
  }
  $tree;
}

sub is_quiet {
  my($a,$b,$tag)=@_;
  return if $a eq $b;
  is($a,$b,$tag);
}
sub ok_quiet {
  my($bool,$tag)=@_;
  return if $bool;
  ok($bool,$tag);
}

sub min {
  if ($#_==0) {@_=@{$_[0]} if 'ARRAY' eq ref $_[0];}
  return undef unless @_;
  if ($#_==1) {my($x,$y)=@_; return ($x<=$y?$x:$y);}
  my $min=shift @_;
  map {$min=$_ if $_<$min} @_;
  $min;
}

sub max {
  if ($#_==0) {@_=@{$_[0]} if 'ARRAY' eq ref $_[0];}
  return undef unless @_;
  if ($#_==1) {my($x,$y)=@_; return ($x>=$y?$x:$y);}
  my $max=shift @_;
  map {$max=$_ if $_>$max} @_;
  $max;
}