#!/usr/bin/perl -w
use
5.004;
plan
tests
=> 1254;
BEGIN { MyTestHelpers::nowarnings(); }
{
my
$want_version
= 129;
ok (
$Math::PlanePath::SierpinskiCurve::VERSION
,
$want_version
,
'VERSION variable'
);
ok (Math::PlanePath::SierpinskiCurve->VERSION,
$want_version
,
'VERSION class method'
);
ok (
eval
{ Math::PlanePath::SierpinskiCurve->VERSION(
$want_version
); 1 },
1,
"VERSION class check $want_version"
);
my
$check_version
=
$want_version
+ 1000;
ok (!
eval
{ Math::PlanePath::SierpinskiCurve->VERSION(
$check_version
); 1 },
1,
"VERSION class check $check_version"
);
my
$path
= Math::PlanePath::SierpinskiCurve->new;
ok (
$path
->VERSION,
$want_version
,
'VERSION object method'
);
ok (
eval
{
$path
->VERSION(
$want_version
); 1 },
1,
"VERSION object check $want_version"
);
ok (!
eval
{
$path
->VERSION(
$check_version
); 1 },
1,
"VERSION object check $check_version"
);
}
{
my
$path
= Math::PlanePath::SierpinskiCurve->new();
ok (
$path
->n_start, 0,
'n_start()'
);
}
{
foreach
my
$elem
([1, 0,0],
[2, 0,0],
[3, 1,0],
[4, 1,0],
[5, 1,1],
[6, 1,1],
[7, 1,1],
[8, 1,1]) {
my
(
$arms
,
$want_x_negative
,
$want_y_negative
) =
@$elem
;
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=>
$arms
);
ok (!!
$path
->x_negative, !!
$want_x_negative
,
'x_negative()'
);
ok (!!
$path
->y_negative, !!
$want_y_negative
,
'y_negative()'
);
}
}
{
my
$path
= Math::PlanePath::SierpinskiCurve->new;
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(0);
ok (
$n_lo
, 0);
ok (
$n_hi
, 0); }
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(1);
ok (
$n_lo
, 0);
ok (
$n_hi
, 3); }
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(2);
ok (
$n_lo
, 0);
ok (
$n_hi
, 15); }
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(3);
ok (
$n_lo
, 0);
ok (
$n_hi
, 63); }
}
{
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=> 2);
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(0);
ok (
$n_lo
, 0);
ok (
$n_hi
, 1); }
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(1);
ok (
$n_lo
, 0);
ok (
$n_hi
, 7); }
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(2);
ok (
$n_lo
, 0);
ok (
$n_hi
, 31); }
}
{
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=> 8);
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(0);
ok (
$n_lo
, 0);
ok (
$n_hi
, 7); }
{
my
(
$n_lo
,
$n_hi
) =
$path
->level_to_n_range(1);
ok (
$n_lo
, 0);
ok (
$n_hi
, 31); }
}
{
foreach
my
$elem
(
[7, 0,-1, 0,-2, 0,27 ],
[1, 0,0, 0,0, 1,0],
[2, 0,0, 0,0, 0,7],
[2, -100,0, -1,0, 1,0],
[3, -1,0, -1,0, 1,0],
[3, -1,1, -1,1, 0,11],
[3, -2,1, -2,1, 1,0],
[4, -2,1, -2,1, 0,15],
[4, -1,-1, -1,-1, 1,0],
[5, -2,-1, -2,-1, 0,19],
[5, 0,-2, 0,-2, 1,0],
[5, -1,-2, -1,-2, 1,0],
[6, -1,-2, -1,-2, 0,23],
[6, 0,-2, 0,-2, 1,0],
[7, 0,-2, 0,-2, 0,27],
[7, 1,-2, 1,-2, 1,0],
[8, 1,-2, 1,-2, 0,31],
) {
my
(
$arms
,
$x1
,
$y1
,
$x2
,
$y2
,
$want_n_lo
,
$want_n_hi
) =
@$elem
;
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=>
$arms
);
my
(
$n_lo
,
$n_hi
) =
$path
->rect_to_n_range (
$x1
,
$y1
,
$x2
,
$y2
);
ok (
$n_hi
,
$want_n_hi
,
"arms=$arms $x1,$y1, $x2,$y2"
);
ok (
$n_lo
,
$want_n_lo
);
}
}
{
my
$bad
= 0;
foreach
my
$arms
(1 .. 8) {
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=>
$arms
);
foreach
my
$n
(0 .. 8
*$arms
) {
my
(
$x
,
$y
) =
$path
->n_to_xy (
$n
);
my
(
$n_lo
,
$n_hi
) =
$path
->rect_to_n_range (
$x
,
$y
,
$x
,
$y
);
unless
(
$n_lo
<=
$n
) {
$bad
++;
}
unless
(
$n_hi
>=
$n
) {
$bad
++;
}
}
}
ok (
$bad
, 0);
}
{
my
@data
= (
[ 0.25, 1.25, 0.25 ],
[ 1.25, 2.25, 1 ],
[ 2.25, 3.25, 0.75 ],
[ 3.25, 4.25, 0.25 ],
[ 4.25, 4.75, 1.25 ],
[ 0, 1,0 ],
[ 1, 2,1 ],
[ 2, 3,1 ],
[ 3, 4,0 ],
[ 4, 5,1 ],
);
my
$path
= Math::PlanePath::SierpinskiCurve->new;
foreach
my
$elem
(
@data
) {
my
(
$n
,
$x
,
$y
) =
@$elem
;
{
my
(
$got_x
,
$got_y
) =
$path
->n_to_xy (
$n
);
if
(
$got_x
== 0) {
$got_x
= 0 }
if
(
$got_y
== 0) {
$got_y
= 0 }
ok (
$got_x
,
$x
,
"n_to_xy() x at n=$n"
);
ok (
$got_y
,
$y
,
"n_to_xy() y at n=$n"
);
}
if
(
$n
==
int
(
$n
)) {
my
$got_n
=
$path
->xy_to_n (
$x
,
$y
);
ok (
$got_n
,
$n
,
"xy_to_n() n at x=$x,y=$y"
);
}
{
$n
=
int
(
$n
);
my
(
$got_nlo
,
$got_nhi
) =
$path
->rect_to_n_range (0,0,
$x
,
$y
);
ok (
$got_nlo
<=
$n
, 1,
"rect_to_n_range() nlo=$got_nlo at n=$n,x=$x,y=$y"
);
ok (
$got_nhi
>=
$n
, 1,
"rect_to_n_range() nhi=$got_nhi at n=$n,x=$x,y=$y"
);
}
}
}
foreach
my
$arms
(1 .. 8) {
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=>
$arms
);
for
(1 .. 5) {
my
$bits
=
int
(
rand
(25));
my
$n
=
int
(
rand
(2*
*$bits
));
my
(
$x
,
$y
) =
$path
->n_to_xy (
$n
);
my
$rev_n
=
$path
->xy_to_n (
$x
,
$y
);
ok (
defined
$rev_n
, 1,
"xy_to_n($x,$y) arms=$arms reverse n, got undef"
);
my
(
$n_lo
,
$n_hi
) =
$path
->rect_to_n_range (
$x
,
$y
,
$x
,
$y
);
ok (
$n_lo
<=
$n
, 1,
"rect_to_n_range() arms=$arms n=$n at xy=$x,$y cf got n_lo=$n_lo"
);
ok (
$n_hi
>=
$n
, 1,
"rect_to_n_range() arms=$arms n=$n at xy=$x,$y cf got n_hi=$n_hi"
);
}
}
foreach
my
$arms
(1 .. 8) {
my
$path
= Math::PlanePath::SierpinskiCurve->new (
arms
=>
$arms
);
for
(1 .. 20) {
my
$bits
=
int
(
rand
(25));
my
$n
=
int
(
rand
(2*
*$bits
)) + 1;
my
$nhex
=
sprintf
'0x%X'
,
$n
;
my
(
$x1
,
$y1
) =
$path
->n_to_xy (
$n
);
my
(
$x2
,
$y2
) =
$path
->n_to_xy (
$n
+
$arms
);
foreach
my
$frac
(0.25, 0.5, 0.75) {
my
$want_xf
=
$x1
+ (
$x2
-
$x1
)
*$frac
;
my
$want_yf
=
$y1
+ (
$y2
-
$y1
)
*$frac
;
my
$nf
=
$n
+
$frac
;
my
(
$got_xf
,
$got_yf
) =
$path
->n_to_xy (
$nf
);
ok (
$got_xf
,
$want_xf
,
"n_to_xy($nf) arms=$arms frac $frac, X (n hex $nhex)"
);
ok (
$got_yf
,
$want_yf
,
"n_to_xy($nf) arms=$arms frac $frac, X (n hex $nhex)"
);
}
}
}
{
my
$bad
= 0;
OUTER:
foreach
my
$d
(0 .. 4) {
foreach
my
$s
(0 .. 4) {
foreach
my
$arms
(1 .. 8) {
my
$path
= Math::PlanePath::SierpinskiCurve->new
(
arms
=>
$arms
,
straight_spacing
=>
$s
,
diagonal_spacing
=>
$d
);
foreach
my
$x
(-8 .. 8) {
foreach
my
$y
(-8 .. 8) {
my
$n
=
$path
->xy_to_n (
$x
,
$y
);
next
unless
defined
$n
;
my
(
$nx
,
$ny
) =
$path
->n_to_xy (
$n
);
if
(
$nx
!=
$x
||
$ny
!=
$y
) {
MyTestHelpers::diag(
"xy_to_n($x,$y) arms=$arms gives n=$n, which is $nx,$ny"
);
last
OUTER
if
++
$bad
> 10;
}
}
}
}
}
}
ok (
$bad
, 0);
}
{
my
$path
= Math::PlanePath::SierpinskiCurve->new;
foreach
my
$i
(0 .. 50) {
my
$x
= 3
*$i
+ 1;
my
$want_n
= duplicate_bits(
$i
);
my
$got_n
=
$path
->xy_to_n (
$x
,0);
ok (
$got_n
,
$want_n
,
"i=$i N at X=$x,Y=0"
);
}
}
sub
duplicate_bits {
my
(
$n
) =
@_
;
my
$bits
=
sprintf
'%b'
,
$n
;
$bits
=~ s/(.)/$1$1/g;
return
oct
(
"0b$bits"
);
}
exit
0;