view release on metacpan or  search on metacpan

t/02_Aesthetic.t  view on Meta::CPAN

# Check if some function is random enough by putting the results in bins
# and seeing if all bins get filled
sub g_is_random {
    my ($g, $f, $mul, $d) = @_;

    $d   ||= 2;
    $mul ||= 1;
    my @bins = ();
    my $size = 10;
    my $seen = 0;
    my $loops = 0;
    my $max_loops = 10000;
    my $expected = 2*$size*$d*$g->vertices;
  TRY:
    while ($loops < $max_loops) {
        $f->($g);
        my $i=0;
        for ($g->vertices) {
            my $pos = $g->get_vertex_attribute($_, "layout_pos");
            for (@$pos) {
                $_ *= $mul * $size;
                if ($_ <= -$size || $_ >= $size) {
                    diag("Value $_ is outside [-$size, $size]");
                    fail("Value outside [-$size, $size]");
                    last TRY;
                }
                my $pos = int($size+$_);
                $bins[$i][$pos] ||= ++$seen;
                $i++;
            }
        }
        $loops++;
        last if $seen == $expected;
    }
    ok($loops < $max_loops, "All values reached");
    is($seen, $expected, "All values reached");
}

eval { Graph::Layout::Aesthetic->new };
like($@, qr!topology is undefined at !i, "Must have a topology argument");

$topo_destroys = 0;
my $topo3 = Graph::Layout::Aesthetic::Topology->new_vertices(3);
$topo3->add_edge(0, 1);
$topo3->add_edge(1, 2);
$topo3->add_edge(2, 0);
eval { Graph::Layout::Aesthetic->new($topo3) };
like($@, qr!Topology hasn.t been finished at !, "Topology must be finished");
$topo3->finish;
eval { Graph::Layout::Aesthetic->new($topo3, -1) };
    like($@, qr!Nr_dimensions must not be negative at!, "Positive dimensionality");

my $aglo = Graph::Layout::Aesthetic->new($topo3);
isa_ok($aglo, "Graph::Layout::Aesthetic", "Created into the right class");
is($aglo->nr_dimensions, 2, "Defaults to two dimensions");
nearly($aglo->temperature, 1e2, "Default temperature is 1e2");
nearly($aglo->end_temperature, 1e-3, "Default end_temperature is 1e-3");
is($aglo->iterations, 1e3, "Default temperature is 1e3");
is($aglo->topology, $topo3, "Topology is available");
$topo3 = undef;
is($topo_destroys, 0, "aglo keeps topology alive");
$force_destroys = 0;
my $force = Graph::Layout::Aesthetic::Force::NodeRepulsion->new;
is($force_destroys, 0, "The force is alive");
$aglo->_add_force($force);
is($force_destroys, 0, "The force is alive");
$force = undef;
is($force_destroys, 0, "The force is alive");
$destroys = 0;
$aglo = undef;
is($destroys, 1, "Cleanup on last reference");
is($topo_destroys, 1, "Toplogy Cleanup on last reference");
is($force_destroys, 1, "The force is gone");

# Recreate topology
$topo_destroys = 0;
$topo3 = Graph::Layout::Aesthetic::Topology->new_vertices(3);
$topo3->add_edge(0, 1);
$topo3->add_edge(1, 2);
$topo3->add_edge(2, 0);
$topo3->finish;

# Play with forces
$aglo = Graph::Layout::Aesthetic->new($topo3, 3);
is($aglo->nr_dimensions, 3, "New listens to nr_dimensions argument");
$aglo = Graph::Layout::Aesthetic->new($topo3, undef);
is($aglo->nr_dimensions, 2, "Undef means two dimensions");
$force_destroys = 0;
$force = Graph::Layout::Aesthetic::Force::NodeRepulsion->new;
$aglo->_add_force($force);
$force = undef;
is($force_destroys, 0, "The force is alive");
$aglo->clear_forces;
is($force_destroys, 1, "The force is dead");
$force_destroys = 0;
my $force1 = Graph::Layout::Aesthetic::Force::NodeRepulsion->new;
$aglo->_add_force($force1);
$force1 = undef;
my $force2 = Graph::Layout::Aesthetic::Force::MinEdgeLength->new;
$aglo->_add_force($force2, 2);
$force2 = undef;
is($force_destroys, 0, "The force is alive");
my @forces = $aglo->forces;
is(@forces, 2, "Two forces");
isa_ok($forces[0][0], "Graph::Layout::Aesthetic::Force::MinEdgeLength",
       "Right force type");
is(@{$forces[0]}, 2, "Two element force members");
is($forces[0][1], 2, "Right weight");
isa_ok($forces[1][0], "Graph::Layout::Aesthetic::Force::NodeRepulsion",
       "Right force type");
is($forces[1][1], 1, "Right default weight");
KillRef->test($forces[0]);
@forces = ();
is($force_destroys, 0, "The force is alive");

my $forces = $aglo->forces;
is(@$forces, 2, "Two forces");
isa_ok($forces->[0][0], "Graph::Layout::Aesthetic::Force::MinEdgeLength",
       "Right force type");
is(@{$forces->[0]}, 2, "Two element force members");
is($forces->[0][1], 2, "Right weight");
isa_ok($forces->[1][0], "Graph::Layout::Aesthetic::Force::NodeRepulsion",
       "Right force type");
is($forces->[1][1], 1, "Right default weight");
KillRef->test($forces->[0]);
KillRef->test($forces);

is($force_destroys, 0, "The force is alive");
$aglo = undef;
is($force_destroys, 2, "The force is dead");

# Check cleanup on the list form of forces
$aglo = Graph::Layout::Aesthetic->new($topo3, 3);
$force_destroys = 0;
$force1 = Graph::Layout::Aesthetic::Force::NodeRepulsion->new;
$aglo->_add_force($force1);
$force1 = undef;
$force2 = Graph::Layout::Aesthetic::Force::MinEdgeLength->new;
$aglo->_add_force($force2, 2);
$force2 = undef;
is($force_destroys, 0, "The force is alive");
@forces = $aglo->forces;

$destroys = 0;
$aglo = undef;
is($destroys, 1, "Cleanup on last reference");

is($force_destroys, 0, "The force is alive");
@forces = 0;
is($force_destroys, 2, "The force is alive");

# Check cleanup on the scalar form of forces
$aglo = Graph::Layout::Aesthetic->new($topo3, 3);
$force_destroys = 0;
$force1 = Graph::Layout::Aesthetic::Force::NodeRepulsion->new;
$aglo->_add_force($force1);
$force1 = undef;
$force2 = Graph::Layout::Aesthetic::Force::MinEdgeLength->new;
$aglo->_add_force($force2, 2);
$force2 = undef;
is($force_destroys, 0, "The force is alive");
$forces = $aglo->forces;

$destroys = 0;
$aglo = undef;
is($destroys, 1, "Cleanup on last reference");

is($force_destroys, 0, "The force is alive");
$forces = undef;
is($force_destroys, 2, "The force is alive");

$force_destroys = 0;
$aglo = Graph::Layout::Aesthetic->new($topo3, 3);
eval { $aglo->_add_force(undef) };
like($@, qr!force is undefined at !i, "Proper error message");
eval { $aglo->add_force };
like($@, qr!No force name at !, "Proper error message");
$aglo->add_force("NodeRepulsion");
$aglo->add_force(min_edge_length => 5);
@forces = $aglo->forces;
isa_ok($forces[0][0], "Graph::Layout::Aesthetic::Force::MinEdgeLength",
       "Right force type");
is($forces[0][1], 5, "Right weight");
isa_ok($forces[1][0], "Graph::Layout::Aesthetic::Force::NodeRepulsion",
       "Right force type");
is($forces[1][1], 1, "Right default weight");
$destroys = 0;
$aglo = undef;
is($destroys, 1, "Cleanup on last reference");
is($force_destroys, 0, "Manager keeps forces alive");

# Getting and setting coordinates
$aglo = Graph::Layout::Aesthetic->new($topo3);
eval { $aglo->coordinates };
like($@, qr!Usage: Graph::Layout::Aesthetic::coordinates\(state, vertex, \.\.\.\) at !,
     "Right error message");
eval { $aglo->coordinates(3) };
like($@, qr!Vertex number 3 is invalid, there are only 3 in the topology at !,
     "Right error message");
eval { $aglo->coordinates(0, 1) };
like($@, qr!Expected 2 coordinates \(dimension\), but got 1 at !,
     "Right error message");
$aglo->coordinates(0, 1, 2);
is_deeply([$aglo->coordinates(0)], [1, 2], "Right coordinates");
my $coords = $aglo->coordinates(0);
is_deeply($coords, [1, 2], "Right coordinates");
KillRef->test($coords);
is_deeply([$aglo->coordinates(0, [5, 6])], [1, 2], "Right coordinates");
is_deeply([$aglo->coordinates(0)], [5, 6], "Right coordinates");
eval { $aglo->coordinates(0, []) };
like($@, qr!Expected 2 coordinates \(dimension\), but got 0 at !,
     "Right error message");
eval { $aglo->coordinates(0, {}) };
like($@, qr!Coordinates reference is not an array reference at !,
     "Right error message");

my @hole; $hole[1]=5;
eval { $aglo->coordinates(0, \@hole) };
like($@, qr!Vertex 0, coordinate 0 is unset at !, "Right error message");

my (@magic_array1, @magic_array2);
tie @magic_array1, "MagicArray", 3, 8;
tie @magic_array2, "MagicArray", 4, 9;
$aglo->coordinates(0, @magic_array1);
is_deeply(scalar $aglo->coordinates(0), [3, 8], "tied access works");
$aglo->coordinates(0, \@magic_array2);
is_deeply(scalar $aglo->coordinates(0), [4, 9], "tied reference access works");

# Getting and setting all_coordinates
$aglo->coordinates(0, 3, 4);
$aglo->coordinates(1, 5, 6);
$aglo->coordinates(2, 7, 8);
my @coords = $aglo->all_coordinates;
is_deeply(\@coords, [[3, 4], [5, 6], [7, 8]], "List query coordinates works");
KillRef->test($coords[0]);
$coords = $aglo->all_coordinates;
is_deeply($coords, [[3, 4], [5, 6], [7, 8]], "Scalar query coordinates works");
KillRef->test($coords->[0]);
KillRef->test($coords);

$aglo->all_coordinates([9, 10], [11, 12], [13, 14]);
is_deeply(scalar $aglo->all_coordinates, [[9, 10], [11, 12], [13, 14]],
          "List set coordinates works");

$aglo->all_coordinates([[15, 16], [17, 18], [19, 20]]);
is_deeply(scalar $aglo->all_coordinates, [[15, 16], [17, 18], [19, 20]],
          "Array reference set coordinates works");

is_deeply(scalar $aglo->all_coordinates([21, 22], [23, 24], [25, 26]),
          [[15, 16], [17, 18], [19, 20]], "Combined get/set returns old");