191 lines
5.0 KiB
Perl
191 lines
5.0 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
use Test::More;
|
|
use strict;
|
|
|
|
BEGIN
|
|
{
|
|
plan tests => 32;
|
|
chdir 't' if -d 't';
|
|
use lib '../lib';
|
|
use_ok ("Graph::Easy::Layout") or die($@);
|
|
};
|
|
|
|
can_ok ("Graph::Easy", qw/
|
|
_trace_path
|
|
_find_path
|
|
_create_cell
|
|
_path_is_clear
|
|
_clear_tries
|
|
_find_path_astar
|
|
_find_path_loop
|
|
|
|
_find_chains
|
|
_assign_ranks
|
|
/);
|
|
|
|
can_ok ("Graph::Easy::Node", qw/
|
|
_shuffle_dir
|
|
/);
|
|
|
|
isnt ($Graph::Easy::VERSION, undef, 'VERSION in Layout');
|
|
|
|
use Graph::Easy;
|
|
|
|
Graph::Easy::Edge::Cell->import (qw/
|
|
EDGE_HOR EDGE_VER EDGE_LABEL_CELL
|
|
EDGE_SHORT_S
|
|
EDGE_END_S
|
|
EDGE_START_N
|
|
/);
|
|
|
|
#############################################################################
|
|
# layout tests
|
|
|
|
my $graph = Graph::Easy->new();
|
|
|
|
is (ref($graph), 'Graph::Easy');
|
|
|
|
is ($graph->error(), '', 'no error yet');
|
|
|
|
my ($src, $dst, $edge) = $graph->add_edge('Bonn','Berlin');
|
|
|
|
my $e = 3; # elements per path cell (x,y,type)
|
|
|
|
#############################################################################
|
|
# _shuffle_dir()
|
|
|
|
my $array = [0,1,2,3];
|
|
|
|
is (join (",",@{ $src->_shuffle_dir($array,0) }), '3,0,2,1', 'shuffle 0' );
|
|
is (join (",",@{ $src->_shuffle_dir($array,90) }), '0,1,2,3', 'shuffle 90' );
|
|
is (join (",",@{ $src->_shuffle_dir($array) }), '0,1,2,3', 'shuffle ' );
|
|
is (join (",",@{ $src->_shuffle_dir($array,270) }), '2,3,1,0', 'shuffle 270');
|
|
is (join (",",@{ $src->_shuffle_dir($array,180) }), '1,2,0,3', 'shuffle 180');
|
|
|
|
#############################################################################
|
|
# _near_places()
|
|
|
|
$src->{x} = 1; $src->{y} = 1;
|
|
|
|
my $cells = {};
|
|
my @places = $src->_near_places($cells);
|
|
is (scalar @places, 4 * 2, '4 places');
|
|
|
|
@places = $src->_near_places($cells,2); # $d == 2
|
|
is (scalar @places, 4 * 2, '4 places');
|
|
|
|
@places = $src->_near_places($cells,3); # $d == 3
|
|
is (scalar @places, 4 * 2, '4 places');
|
|
|
|
@places = $src->_near_places($cells,3,0); # $d == 3, type is 0
|
|
is (scalar @places, 4 * $e, '4 places');
|
|
|
|
# #1+3,1+0,1 ...
|
|
is (join (',', @places), '4,1,16,1,4,32,-2,1,64,1,-2,128', 'places');
|
|
|
|
#############################################################################
|
|
# _find_path()
|
|
|
|
$src->{x} = 1; $src->{y} = 1;
|
|
$dst->{x} = 1; $dst->{y} = 1;
|
|
|
|
my $coords = $graph->_find_path( $src, $dst, $edge);
|
|
|
|
is (scalar @$coords, 1*$e, 'same cell => short edge path');
|
|
|
|
$src->{x} = 1; $src->{y} = 1;
|
|
$dst->{x} = 2; $dst->{y} = 2;
|
|
|
|
$coords = $graph->_find_path( $src, $dst, $edge);
|
|
|
|
#print STDERR "# " . Dumper($coords) . "\n";
|
|
#print STDERR "# " . Dumper($graph->{cells}) . "\n";
|
|
|
|
is (scalar @$coords, 1*$e, 'path with a bend');
|
|
|
|
# mark one cell as already occupied
|
|
$graph->{cells}->{"1,2"} = $src;
|
|
|
|
$src->{x} = 1; $src->{y} = 1;
|
|
$dst->{x} = 1; $dst->{y} = 3;
|
|
|
|
$coords = $graph->_find_path( $src, $dst, $edge);
|
|
|
|
#print STDERR "# " . Dumper($coords) . "\n";
|
|
#print STDERR "# " . Dumper($graph->{cells}) . "\n";
|
|
|
|
is (scalar @$coords, 3*$e, 'u shaped path (|---^)');
|
|
|
|
# block src over/under to avoid an U-shaped path
|
|
$graph->{cells}->{"2,1"} = $src;
|
|
$graph->{cells}->{"0,1"} = $src;
|
|
|
|
$graph->{cache} = {};
|
|
$coords = $graph->_find_path( $src, $dst, $edge);
|
|
|
|
#print STDERR "# " . Dumper($coords) . "\n";
|
|
|
|
# XXX TODO: check what path is actually generated here
|
|
is (scalar @$coords, 7*$e, 'cell already blocked');
|
|
|
|
delete $graph->{cells}->{"1,2"};
|
|
|
|
$coords = $graph->_find_path( $src, $dst, $edge);
|
|
|
|
is (scalar @$coords, 1*$e, 'straight path down');
|
|
is (join (":", @$coords), '1:2:' . (EDGE_SHORT_S() + EDGE_LABEL_CELL()), 'path 1,1 => 1,3');
|
|
|
|
$src->{x} = 1; $src->{y} = 0;
|
|
$dst->{x} = 1; $dst->{y} = 5;
|
|
|
|
$coords = $graph->_find_path( $src, $dst, $edge);
|
|
|
|
is (scalar @$coords, 4*$e, 'straight path down');
|
|
my $type = EDGE_VER();
|
|
my $type_label = EDGE_VER() + EDGE_LABEL_CELL() + EDGE_START_N();
|
|
my $type_end = EDGE_VER() + EDGE_END_S();
|
|
is (join (":", @$coords), "1:1:$type_label:1:2:$type:1:3:$type:1:4:$type_end", 'path 1,0 => 1,5');
|
|
|
|
#############################################################################
|
|
#############################################################################
|
|
|
|
# as_ascii() will load Graph::Easy::Layout::Grid, this provides some
|
|
# additional methods:
|
|
|
|
my $ascii = $graph->as_ascii();
|
|
|
|
can_ok ("Graph::Easy", qw/
|
|
_balance_sizes
|
|
_prepare_layout
|
|
/ );
|
|
|
|
#############################################################################
|
|
# _balance_sizes
|
|
|
|
my $sizes = [ 3, 4, 5 ];
|
|
|
|
$graph->_balance_sizes( $sizes, 3+4+5);
|
|
|
|
is_deeply ( $sizes, [ 3,4,5 ], 'constraint already met');
|
|
|
|
$graph->_balance_sizes( $sizes = [ 3, 4, 5 ], 3+4+5-1);
|
|
is_deeply ( $sizes, [ 3,4,5 ], 'constraint already met');
|
|
|
|
$graph->_balance_sizes( $sizes = [ 3, 4, 5 ], 3+4+5+1);
|
|
is_deeply ( $sizes, [ 4,4,5 ], 'smallest gets bigger');
|
|
|
|
$graph->_balance_sizes( $sizes = [ 3, 3, 3 ], 3*3 + 2);
|
|
is_deeply ( $sizes, [ 4,4,3 ], 'first two smallest get bigger');
|
|
|
|
$graph->_balance_sizes( $sizes = [ 3, 3, 3 ], 3*3 + 3);
|
|
is_deeply ( $sizes, [ 4,4,4 ], 'all got bigger');
|
|
|
|
$graph->_balance_sizes( $sizes = [ 3, 3, 3 ], 3*3 + 4);
|
|
is_deeply ( $sizes, [ 5,4,4 ], 'all got bigger');
|
|
|
|
$graph->_balance_sizes( $sizes = [ 10, 10, 3 ], 20+7);
|
|
is_deeply ( $sizes, [ 10,10,7 ], 'last got bigger');
|
|
|
|
|