Graph-Layout-Aesthetic
view release on metacpan or search on metacpan
t/02_Aesthetic.t view on Meta::CPAN
is($seen, $expected, "All values reached");
}
# 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",
t/02_Aesthetic.t view on Meta::CPAN
$_[0]->randomize($_[1]);
});
# Default randomize is 1
is_random($aglo, sub {
$_[0]->randomize;
my @coords = $aglo->all_coordinates;
for (@coords) {
$_ *= $_[1] for @$_;
}
$aglo->all_coordinates(@coords);
});
# Check jitter
$aglo = Graph::Layout::Aesthetic->new($topo3);
$aglo->zero;
$aglo->jitter;
my $sum = 0;
for ($aglo->all_coordinates) {
$sum+= $_*$_ for @$_;
}
ok($sum > 0, "There was a displacement");
ok($sum < 1e-5, "But not too big");
is_random($aglo, sub {
$_[0]->zero;
$_[0]->jitter($_[1]);
});
# Default jitter is 1e-5
is_random($aglo, sub {
$_[0]->zero;
$_[0]->jitter;
my @coords = $aglo->all_coordinates;
for (@coords) {
$_ *= $_[1]/1e-5 for @$_;
}
$aglo->all_coordinates(@coords);
});
# Checking frame
$aglo = Graph::Layout::Aesthetic->new($topo3);
$aglo->all_coordinates([3, 6], [7, 4], [5, 10]);
is_deeply([$aglo->frame], [[3, 4], [7, 10]], "Right frame");
# Checking iso_frame
$aglo = Graph::Layout::Aesthetic->new($topo3);
$aglo->all_coordinates([3, 6], [7, 4], [5, 10]);
is_deeply([$aglo->iso_frame], [[2, 4], [8, 10]], "Right iso frame");
# Check normalize
$aglo = Graph::Layout::Aesthetic->new($topo3);
$aglo->all_coordinates([3, 6], [7, 4], [5, 12]);
$aglo->normalize;
is_deeply(scalar $aglo->all_coordinates, [[1/4, 1/4], [3/4, 0], [1/2, 1]],
"Right normalization");
# Checking init_gloss
$aglo = Graph::Layout::Aesthetic->new($topo3);
$aglo->zero;
$aglo->init_gloss(2, 1, 3, -1);
is($aglo->temperature, 2, "Temperature set");
is($aglo->end_temperature, 1, "End temperature set");
is($aglo->iterations, 3, "Iterations set");
is_deeply(scalar $aglo->all_coordinates, [[0, 0], [0, 0], [0, 0]],
"Vertices unmoved");
# Randomize if given
is_random($aglo, sub {
$_[0]->zero;
$_[0]->init_gloss(2, 1, 3, $_[1]);
});
# Default randomize is 1
is_random($aglo, sub {
$_[0]->zero;
$_[0]->init_gloss(2, 1, 3);
my @coords = $aglo->all_coordinates;
for (@coords) {
$_ *= $_[1] for @$_;
}
$aglo->all_coordinates(@coords);
});
eval { $aglo->init_gloss(2, 1, -1) };
like($@, qr!Iterations -1 should be >= 0 at !,
"Iterations must be non-negative");
eval { $aglo->init_gloss(0, 1, 1) };
like($@, qr!Temperature 0\.0+ should be > 0 at !,
"Temperature must be positive");
eval { $aglo->init_gloss(1, 0, 1) };
like($@, qr!End_temperature 0\.0+ should be > 0 at !,
"End_temperature must be positive");
check_warnings;
$aglo->init_gloss(1, 2, 1);
is(@warnings, 1, "One warning");
like($warnings[0],
qr!Temperature 1\.0+ should probably be >= end_temperature 2\.0+ at !,
"Temperature should decrease");
@warnings = ();
# Checking step
# If there are nor forces, step is jitter
$aglo = Graph::Layout::Aesthetic->new($topo3);
$aglo->zero;
$aglo->step;
$sum = 0;
for ($aglo->all_coordinates) {
$sum+= $_*$_ for @$_;
}
ok($sum > 0, "There was a displacement");
ok($sum < 1e-5, "But not too big");
is_random($aglo, sub {
$_[0]->zero;
$_[0]->step(100, $_[1]);
});
# Default jitter is 1e-5
is_random($aglo, sub {
$_[0]->zero;
$_[0]->step;
my @coords = $aglo->all_coordinates;
for (@coords) {
$_ *= $_[1]/1e-5 for @$_;
}
$aglo->all_coordinates(@coords);
});
is($aglo->iterations, 1000, "Iterations unchanged by step");
is($aglo->temperature, 1e2, "Temperature unchanged by step");
# Default jitter is 1e-5, but temperature restricted
is_random($aglo, sub {
$_[0]->zero;
$_[0]->step(1e-6);
my @coords = $aglo->all_coordinates;
for (@coords) {
$_ *= $_[1]/1e-6 for @$_;
}
$aglo->all_coordinates(@coords);
});
is($aglo->temperature, 1e2,
"Temperature unchanged by explicite temperature step");
$aglo->zero;
$aglo->step(100, 0);
is_deeply(scalar $aglo->all_coordinates, [[0, 0], [0,0], [0, 0]],
"All coordinates remain zero");
# Combine step checking and gradient checking
my $topo2 = Graph::Layout::Aesthetic::Topology->new_vertices(2);
$topo2->add_edge(0, 1);
$topo2->finish;
$aglo = Graph::Layout::Aesthetic->new($topo2);
$aglo->add_force("min_edge_length");
$aglo->all_coordinates([0, -1], [0, 1]);
my @gradient = $aglo->gradient;
is_deeply(\@gradient, [[0, 4], [0, -4]], "Quadratic attraction");
KillRef->test($gradient[0]);
my $gradient = $aglo->gradient;
is_deeply($gradient, [[0, 4], [0, -4]], "Quadratic attraction");
KillRef->test($gradient->[0]);
KillRef->test($gradient);
# Now let the gradient work on the given state
$aglo->step(10, 0);
is_deeply(scalar $aglo->all_coordinates, [[0, 3], [0, -3]]);
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->step(4, 0);
@coords = $aglo->all_coordinates;
is($coords[0][0], 0);
nearly($coords[0][1], -1+4/sqrt 2, "Temperature restricted");
is($coords[1][0], 0);
nearly($coords[1][1], 1-4/sqrt 2, "Temperature restricted");
# Try along the other axis too
$aglo->all_coordinates([0, -1], [0, 1]);
my $tries = 1000;
while ($tries > 0) {
$tries++;
$aglo->step;
last if $aglo->coordinates(0)->[0];
}
ok($tries, "Sometimes we jitter off the axis");
$aglo->all_coordinates([-1, 0], [1, 0]);
is_deeply(scalar $aglo->gradient, [[4, 0], [-4, 0]]);
$aglo->step(10, 0);
is_deeply(scalar $aglo->all_coordinates, [[3, 0], [-3, 0]]);
$aglo->clear_forces;
is_deeply(scalar $aglo->gradient, [[0, 0], [0, 0]]);
$aglo->all_coordinates([-1, 0], [1, 0]);
$aglo->add_force("min_edge_length", 1/2);
is_deeply(scalar $aglo->gradient, [[2, 0], [-2, 0]]);
$aglo->step(10, 0);
is_deeply(scalar $aglo->all_coordinates, [[1, 0], [-1, 0]], "Half step");
# Additive force....
$aglo->all_coordinates([-1, 0], [1, 0]);
$aglo->add_force("min_edge_length", 3/2);
is_deeply(scalar $aglo->gradient, [[8, 0], [-8, 0]]);
$aglo->step(12, 0);
is_deeply(scalar $aglo->all_coordinates, [[7, 0], [-7, 0]], "Double step");
# Checking stress
$aglo = Graph::Layout::Aesthetic->new($topo2);
$aglo->add_force("min_edge_length");
$aglo->all_coordinates([0, -1], [0, 1]);
is_deeply(scalar $aglo->gradient, [[0, 4], [0, -4]], "Quadratic attraction");
nearly($aglo->stress, 4*sqrt 2, "Stressed out");
# Checking _gloss
$aglo = Graph::Layout::Aesthetic->new($topo2);
$aglo->add_force("min_edge_length");
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->_gloss(0);
is($aglo->iterations, 999, "Iterations lowered");
nearly($aglo->temperature, 100 / (100/1e-3)**(1/1000), "Temperature lowered");
nearly($aglo->end_temperature, 1e-3, "End_temperature unchanged");
{
local $EPS = 1e-4;
@coords = $aglo->all_coordinates;
nearly($coords[0][0], 0);
nearly($coords[0][1], 3);
nearly($coords[1][0], 0);
nearly($coords[1][1],-3);
}
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->init_gloss(100, 1, 1, 0);
$aglo->_gloss();
is($aglo->iterations, 0, "Iterations lowered");
nearly($aglo->temperature, 1, "Temperature lowered");
nearly($aglo->end_temperature, 1, "End_temperature unchanged");
{
local $EPS = 1e-4;
@coords = $aglo->all_coordinates;
nearly($coords[0][0], 0);
nearly($coords[0][1], 3);
nearly($coords[1][0], 0);
nearly($coords[1][1],-3);
}
$aglo->end_temperature(1e-3);
eval { $aglo->_gloss() };
like($@, qr!No more iterations left at !, "Can't iterate beyond 0");
is($aglo->iterations, 0, "Iterations unchanged");
nearly($aglo->temperature, 1, "Temperature unchanged");
$aglo->add_force("node_repulsion");
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->init_gloss(100, 1e-3, 1000, 0);
$aglo->_gloss(time);
is($aglo->iterations, 999, "Time based finish");
$aglo->_gloss(10000+time);
is($aglo->iterations, 0, "Enough time to finish");
@coords = $aglo->all_coordinates;
my $distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 1, "Balance");
nearly($aglo->stress, 0, "Balance");
}
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->init_gloss(100, 1e-3, 1000, 0);
$aglo->_gloss();
is($aglo->iterations, 0, "Enough time to finish");
@coords = $aglo->all_coordinates;
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 1, "Balance");
nearly($aglo->stress, 0, "Balance");
}
# Checking gloss
$aglo = Graph::Layout::Aesthetic->new($topo3);
is_random($aglo, sub {
# One-step gloss without forces and hold is just a randomize
$aglo->all_coordinates([3, 6], [7, 4], [5, 10]);
$aglo->gloss(iterations => 1);
my @coords = $aglo->all_coordinates;
for (@coords) {
$_ *= $_[1] for @$_;
}
$aglo->all_coordinates(@coords);
});
$aglo = Graph::Layout::Aesthetic->new($topo2);
$aglo->add_force("min_edge_length");
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->end_temperature(1);
$aglo->gloss(iterations => 1, hold => 1);
is($aglo->iterations, 0, "Iterations lowered");
nearly($aglo->temperature, 1e-3, "Temperature lowered");
nearly($aglo->end_temperature, 1e-3, "End_temperature unchanged");
{
local $EPS = 1e-4;
@coords = $aglo->all_coordinates;
nearly($coords[0][0], 0);
nearly($coords[0][1], 3);
nearly($coords[1][0], 0);
nearly($coords[1][1],-3);
}
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->gloss(begin_temperature => 4, iterations => 1, hold => 1);
@coords = $aglo->all_coordinates;
{
local $EPS = 1e-4;
nearly($coords[0][0], 0);
nearly($coords[0][1], -1+4/sqrt 2, "Temperature restricted");
nearly($coords[1][0], 0);
nearly($coords[1][1], 1-4/sqrt 2, "Temperature restricted");
}
$aglo->add_force("node_repulsion");
$aglo->all_coordinates([0, -1], [0, 1]);
$aglo->gloss(hold => 1, end_temperature => 2e-3);
is($aglo->iterations, 0, "Enough time to finish");
nearly($aglo->temperature, 2e-3, "Temperature lowered");
nearly($aglo->end_temperature, 2e-3, "End_temperature reached");
@coords = $aglo->all_coordinates;
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 1, "Balance");
nearly($aglo->stress, 0, "Balance");
}
eval { $aglo->gloss(foo => 5) };
like($@, qr!Unknown parameter foo at !, "Right error message");
# Accepts iterations 0
$aglo->gloss(iterations => 0);
$aglo->gloss(iterations => 0, monitor => sub {});
# Test monitor CODE ref
$count = 0;
$aglo->gloss(monitor_delay => 10000, monitor => sub { $count++ });
is($count, 2, "Begin and end call");
# Test monitor object
$count = 0;
$aglo->gloss(monitor_delay => 10000, monitor => TestMonitor->new);
is($count, 2, "Begin and end call");
is($monitors, 0, "Monitor got freed again");
$count = 0;
$aglo->gloss(monitor_delay => 0, monitor => sub { $count++ });
is($count, 1001, "Begin and end call and all inbetweens");
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 1, "Balance");
nearly($aglo->stress, 0, "Balance");
}
# Checking temperature
$aglo = Graph::Layout::Aesthetic->new($topo3);
is($aglo->temperature, 100, "Right default temperature");
$aglo->temperature(1000);
is($aglo->temperature, 1000, "Right temperature setting");
is($aglo->temperature(500), 1000, "Combined temperature get/set");
is($aglo->temperature, 500, "Right value after get/set");
eval { $aglo->temperature(0) };
like($@, qr!Temperature 0\.0+ should be > 0 at !,
"Temperature must be positive");
is($aglo->temperature, 500, "Unchanged on failure");
is($aglo->temperature(1e-4, 0), 500, "Combined get, but set below end");
check_warnings;
nearly($aglo->temperature(2e-4, 1), 1e-4, "Combined get, but set below end");
is(@warnings, 1, "One warning");
like($warnings[0], qr!Temperature 0\.00020* should probably be >= end_temperature 0\.0010* at!, "Proper warning");
@warnings = ();
nearly($aglo->temperature(3e-4), 2e-4, "Combined get, but set below end");
is(@warnings, 1, "One warning");
like($warnings[0], qr!Temperature 0\.00030* should probably be >= end_temperature 0\.0010* at!, "Proper warning");
@warnings = ();
nearly($aglo->temperature, 3e-4, "Combined get, but set below end");
# Checking end_temperature
$aglo = Graph::Layout::Aesthetic->new($topo3);
nearly($aglo->end_temperature, 1e-3, "Right default temperature");
$aglo->end_temperature(1);
is($aglo->end_temperature, 1, "Right temperature setting");
is($aglo->end_temperature(2), 1, "Combined temperature get/set");
is($aglo->end_temperature, 2, "Right value after get/set");
eval { $aglo->end_temperature(0) };
like($@, qr!End_temperature 0\.0+ should be > 0 at !,
"End_temperature must be positive");
is($aglo->end_temperature, 2, "Unchanged on failure");
is($aglo->end_temperature(500, 0), 2, "Combined get, but set above current");
check_warnings;
nearly($aglo->end_temperature(200, 1), 500, "Combined get, but set below end");
is(@warnings, 1, "One warning");
like($warnings[0], qr!Temperature 100\.0+ should probably be >= end_temperature 200\.0+ at !, "Proper warning");
@warnings = ();
nearly($aglo->end_temperature(300), 200, "Combined get, but set below end");
is(@warnings, 1, "One warning");
like($warnings[0], qr!Temperature 100\.0+ should probably be >= end_temperature 300\.0+ at !, "Proper warning");
@warnings = ();
nearly($aglo->end_temperature, 300, "Combined get, but set below end");
# Checking iterations
$aglo = Graph::Layout::Aesthetic->new($topo3);
is($aglo->iterations, 1000, "Proper default");
$aglo->iterations(100);
is($aglo->iterations, 100, "Settable");
is($aglo->iterations(200), 100, "Combined get/set");
is($aglo->iterations, 200, "Value changed");
eval { $aglo->iterations(-1) };
like($@, qr!Iterations -1 should be >= 0 at !, "Proper error message");
is($aglo->iterations, 200, "Value unchanged on error");
# Checking pause
$aglo = Graph::Layout::Aesthetic->new($topo3);
is($aglo->paused, "", "The default is unpaused");
is($aglo->paused, "", "Paused without args doesn't change a false state");
$aglo->pause;
is($aglo->paused, 1, "Pause sets the pause flag");
is($aglo->paused, 1, "Paused without args doesn't change a false state");
$aglo->pause;
is($aglo->paused, 1, "Pause is idempotent");
is($aglo->paused("foo"), 1, "Combined assign returns old value");
is($aglo->paused, 1, "Everything true is equivalent");
is($aglo->paused(undef), 1, "Combined assign returns old value");
is($aglo->paused(0), "", "Undef is false");
is($aglo->paused(""), "", "0 is false");
is($aglo->paused, "", "\"\" is false");
# The corresponding tests for _gloss will be done in the perl force tester
# since we need a gradient callback for them
for my $start_pause (0, 1) {
my $count = 0;
$aglo->paused($start_pause);
$aglo->gloss(iterations => 3,
monitor_delay => 0,
monitor => sub {
is($aglo->paused, "");
$count++;
});
is($count, 4, "Done all counts");
is($aglo->paused, "");
for $_ (0..3) {
my $count = 0;
$aglo->paused($start_pause);
$aglo->gloss(iterations => 3,
monitor_delay => 0,
monitor => sub {
my $aglo = shift;
is($aglo->paused, "");
$aglo->pause if $count == $_;
$count++;
});
is($count, $_+1, "Done only start event");
is($aglo->iterations, 3-$_, "No iterations done");
is($aglo->paused, 1);
}
}
can_ok("Graph::Layout::Aesthetic", qw(coordinates_to_graph gloss_graph));
my $graph_class = eval "use Graph; 1" ? "Graph" : undef;
if ($graph_class && $Graph::VERSION >= 0.50) {
# Check coordinates_to_graph
my $g = $graph_class->new;
$g->add_edge("foo0", "foo1");
$g->add_edge("foo0", "foo2");
$g->add_edge("foo2", "foo0");
$g->add_edge("foo2", "foo3");
$g->add_edge("foo3", "foo3");
my $t = Graph::Layout::Aesthetic::Topology->from_graph
($g, id_attribute => undef);
is($t->nr_vertices, 4);
$aglo = Graph::Layout::Aesthetic->new($t);
$aglo->all_coordinates([1, 2], [3, 4], [5, 6], [7, 8]);
$g->set_vertex_attribute("foo0", "index", 3);
$g->set_vertex_attribute("foo1", "index", 2);
$g->set_vertex_attribute("foo2", "index", 0);
$g->set_vertex_attribute("foo3", "index", 1);
ok(!$g->has_vertex_attribute("foo0", "foo"));
ok(!$g->has_graph_attribute("bar"));
ok(!$g->has_graph_attribute("baz"));
$aglo->coordinates_to_graph($g,
pos_attribute => "foo",
min_attribute => "bar",
max_attribute => "baz",
id_attribute => "index");
is_deeply($g->get_vertex_attribute("foo0", "foo"), [7, 8]);
is_deeply($g->get_vertex_attribute("foo1", "foo"), [5, 6]);
is_deeply($g->get_vertex_attribute("foo2", "foo"), [1, 2]);
is_deeply($g->get_vertex_attribute("foo3", "foo"), [3, 4]);
is_deeply($g->get_graph_attribute("bar"), [1, 2]);
is_deeply($g->get_graph_attribute("baz"), [7, 8]);
ok(!$g->get_vertex_attribute("foo0", "x"));
ok(!$g->get_graph_attribute($_)) for qw(i j k l);
$aglo->coordinates_to_graph($g,
pos_attribute => ["x", "y"],
min_attribute => ["i", "j"],
max_attribute => ["k", "l"],
id_attribute => "index");
is($g->get_vertex_attribute("foo0", "x"), 7);
is($g->get_vertex_attribute("foo0", "y"), 8);
is($g->get_vertex_attribute("foo1", "x"), 5);
is($g->get_vertex_attribute("foo1", "y"), 6);
is($g->get_vertex_attribute("foo2", "x"), 1);
is($g->get_vertex_attribute("foo2", "y"), 2);
is($g->get_vertex_attribute("foo3", "x"), 3);
is($g->get_vertex_attribute("foo3", "y"), 4);
is($g->get_graph_attribute("i"), 1);
is($g->get_graph_attribute("j"), 2);
is($g->get_graph_attribute("k"), 7);
t/02_Aesthetic.t view on Meta::CPAN
is_deeply($g->get_graph_attribute("layout_max"), [7, 8]);
eval { $aglo->coordinates_to_graph($g,
pos_attribute => [4],
id_attribute => \%attr) };
like($@, qr!^Number of entries in the position attribute array must be equal to the number of dimensions at !,
"Proper dimensionalitry check on attribute");
eval { $aglo->coordinates_to_graph($g,
min_attribute => [4],
id_attribute => \%attr) };
like($@, qr!^Number of entries in the minimum attribute array must be equal to the number of dimensions at !,
"Proper dimensionalitry check on attribute");
eval { $aglo->coordinates_to_graph($g,
max_attribute => [4],
id_attribute => \%attr) };
like($@, qr!^Number of entries in the maximum attribute array must be equal to the number of dimensions at !,
"Proper dimensionalitry check on attribute");
# Check gloss_graph
$g = $graph_class->new;
$g->add_edge("foo0", "foo1");
eval { Graph::Layout::Aesthetic->gloss_graph($g) };
like($@, qr!^No forces were defined at !);
eval { Graph::Layout::Aesthetic->gloss_graph($g, forces => undef) };
like($@, qr!^No forces were defined at !);
eval { Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
Zoem => 8) };
like($@, qr!^Unknown parameter Zoem at !, "Bad parameters get recognized");
eval { Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
hold => "zzz") };
like($@,
qr!^Attribute 'zzz' for vertex 'foo\d' is not an array reference at !,
"Copy attempt if hold given");
eval { Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
hold => 1) };
like($@, qr!^Attribute 'layout_pos' for vertex 'foo\d' is not an array reference at !,
"Copy attempt from layout_pos if hold is 1");
eval { Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
pos_attribute => "yyy",
hold => 1) };
like($@,
qr!^Attribute 'yyy' for vertex 'foo\d' is not an array reference at !,
"Copy attempt from layout_pos if hold is 1");
eval { Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
pos_attribute => ["x", "y"],
hold => 1) };
like($@,
qr!^Attribute 'x' for vertex 'foo\d' doesn.t exist at !,
"Copy attempt from layout_pos if hold is 1");
ok(!$g->has_vertex_attribute("layout_pos", "foo0"),
"No layout_pos attribute yet");
ok(!$g->has_graph_attribute("layout_min"), "No layout_min attribute yet");
ok(!$g->has_graph_attribute("layout_max"), "No layout_max attribute yet");
Graph::Layout::Aesthetic->gloss_graph($g, forces => {}, iterations => 1);
ok($g->has_vertex_attribute("foo0", "layout_pos"), "Pos attribute now");
is(@{$g->get_vertex_attribute("foo0", "layout_pos")}, 2,
"Default 2 dimensions");
ok($g->has_graph_attribute("layout_min"), "Min attribute now");
is(@{$g->get_graph_attribute("layout_min")}, 2, "Default 2 dimensions");
ok($g->has_graph_attribute("layout_max"), "Max attribute now");
is(@{$g->get_graph_attribute("layout_max")}, 2, "Default 2 dimensions");
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
iterations => 1,
nr_dimensions => 3);
is(@{$g->get_vertex_attribute("foo0", "layout_pos")}, 3,
"Three dimensions if requested");
is(@{$g->get_graph_attribute("layout_min")}, 3,
"Three dimensions if requested");
is(@{$g->get_graph_attribute("layout_max")}, 3,
"Three dimensions if requested");
# At 0 iterations gloss_graph should behave like init_gloss
$g->set_vertex_attribute("foo0", "layout_pos", [2, 2]);
$g->set_graph_attribute("layout_min", [3, 3]);
$g->set_graph_attribute("layout_max", [4, 4]);
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
iterations => 0);
for my $pos ($g->get_vertex_attribute("foo0", "layout_pos"),
$g->get_graph_attribute("layout_min"),
$g->get_graph_attribute("layout_max")) {
ok(-1 < $pos->[0]);
ok($pos->[0] < 1);
ok(-1 < $pos->[1]);
ok($pos->[1] < 1);
}
$g->set_vertex_attribute("foo0", "layout_pos", [2, 3]);
$g->set_graph_attribute("layout_min", "abba");
$g->set_graph_attribute("layout_max", {z => 4});
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
iterations => 0,
hold => 1,
min_attribute => undef,
max_attribute => undef);
is_deeply($g->get_vertex_attribute("foo0", "layout_pos"), [2, 3]);
is($g->get_graph_attribute("layout_min"), "abba");
is_deeply($g->get_graph_attribute("layout_max"), {z => 4});
$g->set_vertex_attribute("foo0", "layout_pos", [4, 5]);
ok(!$g->has_vertex_attribute("foo0", "www"), "No www attribute yet");
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {},
iterations => 0,
pos_attribute => "www",
hold => "layout_pos");
is_deeply($g->get_vertex_attribute("foo0", "www"), [4, 5]);
g_is_random($g, sub {
Graph::Layout::Aesthetic->gloss_graph($_[0],
forces => {},
iterations => 0);
});
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {
min_edge_length => 1,
node_repulsion => 1,
});
$coords[0] = $g->get_vertex_attribute("foo0", "layout_pos");
$coords[1] = $g->get_vertex_attribute("foo1", "layout_pos");
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 1, "Balance");
}
$count = 0;
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {
min_edge_length => 1/4,
node_repulsion => 2,
},
monitor => sub { $count++},
monitor_delay => 0);
is($count, 1001, "Default number of iterations");
$coords[0] = $g->get_vertex_attribute("foo0", "layout_pos");
$coords[1] = $g->get_vertex_attribute("foo1", "layout_pos");
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 2, "Balance");
}
if (eval { require Graph::Directed }) {
my $g = Graph::Directed->new;
$g->add_edge("foo0", "foo1");
Graph::Layout::Aesthetic->gloss_graph($g,
literal => 1,
forces => {
min_edge_length => 1,
parent_left => 1,
});
$coords[0] = $g->get_vertex_attribute("foo0", "layout_pos");
$coords[1] = $g->get_vertex_attribute("foo1", "layout_pos");
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 2.5, "Balance");
}
Graph::Layout::Aesthetic->gloss_graph($g,
forces => {
min_edge_length => 1,
parent_left => 1,
});
$coords[0] = $g->get_vertex_attribute("foo0", "layout_pos");
$coords[1] = $g->get_vertex_attribute("foo1", "layout_pos");
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 2.5, "Balance");
}
$g = Graph::Directed->new;
$g->add_edge("foo0", "foo1");
$g->add_edge("foo1", "foo0");
Graph::Layout::Aesthetic->gloss_graph($g,
literal => 1,
forces => {
min_edge_length => 1,
parent_left => 1,
});
$coords[0] = $g->get_vertex_attribute("foo0", "layout_pos");
$coords[1] = $g->get_vertex_attribute("foo1", "layout_pos");
$distance = sqrt(($coords[0][0]-$coords[1][0])**2 +
($coords[0][1]-$coords[1][1])**2);
{
local $EPS = 2e-2;
nearly($distance, 0, "Balance");
}
Graph::Layout::Aesthetic->gloss_graph($g,
( run in 1.397 second using v1.01-cache-2.11-cpan-71847e10f99 )