first commit
This commit is contained in:
douboer
168
perl/lib/Graph-Easy-0.76/t/astar.t
Normal file
168
perl/lib/Graph-Easy-0.76/t/astar.t
Normal file
@@ -0,0 +1,168 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use Test::More;
|
||||
use strict;
|
||||
|
||||
BEGIN
|
||||
{
|
||||
plan tests => 21;
|
||||
chdir 't' if -d 't';
|
||||
use lib '../lib';
|
||||
use_ok ("Graph::Easy") or die($@);
|
||||
};
|
||||
|
||||
can_ok ("Graph::Easy", qw/
|
||||
new
|
||||
_find_path_astar
|
||||
_astar_distance
|
||||
_astar_modifier
|
||||
_astar_edge_type
|
||||
/);
|
||||
|
||||
can_ok ("Graph::Easy::Heap", qw/
|
||||
new
|
||||
extract_top
|
||||
add
|
||||
/);
|
||||
|
||||
use Graph::Easy::Edge::Cell qw/
|
||||
EDGE_N_E EDGE_N_W EDGE_S_E EDGE_S_W
|
||||
EDGE_HOR EDGE_VER
|
||||
/;
|
||||
|
||||
#############################################################################
|
||||
# _distance tests
|
||||
|
||||
my $dis = 'Graph::Easy::_astar_distance';
|
||||
my $mod = 'Graph::Easy::_astar_modifier';
|
||||
my $typ = 'Graph::Easy::_astar_edge_type';
|
||||
|
||||
{ no strict 'refs';
|
||||
|
||||
is (&$dis( 0,0, 3,0 ), 3 + 0 + 0, '0,0 => 3,0: 4 (no corner)');
|
||||
is (&$dis( 3,0, 3,5 ), 0 + 5 + 0, '3,0 => 3,5: 5 (no corner)');
|
||||
is (&$dis( 0,0, 3,5 ), 3 + 5 + 1, '0,0 => 3,5: 3+5+1 (one corner)');
|
||||
|
||||
is (&$mod( 0,0 ), 1, 'modifier(0,0) is 1');
|
||||
is (&$mod( 0,0, 1,0, 0,1 ), 7, 'going round a bend is 7');
|
||||
is (&$mod( 0,0, 1,0, -1,0 ), 1, 'going straight is 1');
|
||||
|
||||
is (&$typ( 0,0, 1,0, 2,0 ), EDGE_HOR, 'EDGE_HOR');
|
||||
is (&$typ( 2,0, 3,0, 4,0 ), EDGE_HOR, 'EDGE_HOR');
|
||||
is (&$typ( 4,0, 3,0, 2,0 ), EDGE_HOR, 'EDGE_HOR');
|
||||
|
||||
is (&$typ( 2,0, 2,1, 2,2 ), EDGE_VER, 'EDGE_VER');
|
||||
is (&$typ( 2,2, 2,3, 2,4 ), EDGE_VER, 'EDGE_VER');
|
||||
is (&$typ( 2,2, 2,1, 2,0 ), EDGE_VER, 'EDGE_VER');
|
||||
|
||||
is (&$typ( 0,0, 1,0, 1,1 ), EDGE_S_W, 'EDGE_S_W');
|
||||
is (&$typ( 1,1, 1,0, 0,0 ), EDGE_S_W, 'EDGE_S_W');
|
||||
|
||||
is (&$typ( 1,1, 1,0, 2,0 ), EDGE_S_E, 'EDGE_S_E');
|
||||
is (&$typ( 2,0, 1,0, 1,1 ), EDGE_S_E, 'EDGE_S_E');
|
||||
|
||||
is (&$typ( 0,0, 1,0, 1,-1 ), EDGE_N_W, 'EDGE_N_W');
|
||||
is (&$typ( 1,-1, 1,0, 0,0 ), EDGE_N_W, 'EDGE_N_W');
|
||||
|
||||
#print &$typ( 1,2, 2,2, 2,1),"\n";
|
||||
#print &$typ( 0,2, 1,2, 2,2),"\n";
|
||||
#print &$typ( 0,1, 0,2, 1,2),"\n";
|
||||
|
||||
}
|
||||
|
||||
exit;
|
||||
|
||||
#############################################################################
|
||||
# path finding tests
|
||||
|
||||
my $graph = Graph::Easy->new();
|
||||
|
||||
is (ref($graph), 'Graph::Easy');
|
||||
|
||||
is ($graph->error(), '', 'no error yet');
|
||||
|
||||
my $node = Graph::Easy::Node->new( name => 'Bonn' );
|
||||
my $node2 = Graph::Easy::Node->new( name => 'Berlin' );
|
||||
|
||||
my $cells = {};
|
||||
place($cells, $node, 0, 0);
|
||||
place($cells, $node2, 3, 0);
|
||||
|
||||
#my $path = $graph->_find_path_astar( $cells, $node, $node2 );
|
||||
|
||||
#is_deeply ($path, [ 0,0, 1,0, 2,0, 3,0 ], '0,0 => 1,0 => 2,0 => 3,0');
|
||||
|
||||
place($cells, $node, 0, 0);
|
||||
place($cells, $node2, 3, 1);
|
||||
|
||||
#$path = $graph->_find_path_astar( $cells, $node, $node2 );
|
||||
#is_deeply ($path, [ 0,0, 1,0, 2,0, 3,0, 3,1 ], '0,0 => 1,0 => 2,0 => 3,0 => 3,1');
|
||||
|
||||
$cells = {};
|
||||
place($cells, $node, 5, 7);
|
||||
$node2->{cx} = 2;
|
||||
$node2->{cy} = 2;
|
||||
place($cells, $node2, 14, 14);
|
||||
|
||||
block ($cells,13,14);
|
||||
block ($cells,14,13);
|
||||
block ($cells,13,15);
|
||||
block ($cells,15,13);
|
||||
block ($cells,14,16);
|
||||
block ($cells,16,14);
|
||||
|
||||
#block ($cells,3,11);
|
||||
#block ($cells,3,10);
|
||||
#block ($cells,4,9);
|
||||
#block ($cells,5,9);
|
||||
#block ($cells,5,11);
|
||||
#block ($cells,5,13);
|
||||
|
||||
#for (5..15)
|
||||
# {
|
||||
# block ($cells,15,$_);
|
||||
# block ($cells,$_,5);
|
||||
# block ($cells,$_,15);
|
||||
# }
|
||||
#block ($cells,15,16);
|
||||
#block ($cells,14,17);
|
||||
#block ($cells,3,16);
|
||||
|
||||
$graph->{cells} = $cells;
|
||||
$graph->{_astar_bias} = 0;
|
||||
my ($p, $closed, $open) = $graph->_find_path_astar($node, $node2 );
|
||||
|
||||
#use Data::Dumper; print Dumper($cells);
|
||||
|
||||
open FILE, ">test.html" or die ("Cannot write test.html: $!");
|
||||
print FILE $graph->_map_as_html($cells, $p, $closed, $open);
|
||||
close FILE;
|
||||
|
||||
sub block
|
||||
{
|
||||
my ($cells, $x,$y) = @_;
|
||||
|
||||
$cells->{"$x,$y"} = 1;
|
||||
}
|
||||
|
||||
sub place
|
||||
{
|
||||
my ($cells, $node,$x,$y) = @_;
|
||||
|
||||
my $c = ($node->{cx} || 1) - 1;
|
||||
my $r = ($node->{cy} || 1) - 1;
|
||||
|
||||
$node->{x} = $x; $node->{y} = $y;
|
||||
|
||||
for my $rr (0..$r)
|
||||
{
|
||||
my $cy = $y + $rr;
|
||||
for my $cc (0..$c)
|
||||
{
|
||||
my $cx = $x + $cc;
|
||||
$cells->{"$cx,$cy"} = $node;
|
||||
}
|
||||
}
|
||||
diag ("Placing $node->{name} at $node->{x},$node->{y}\n");
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user