File Coverage

blib/lib/Path/Hilbert/BigInt.pm
Criterion Covered Total %
statement 63 66 95.4
branch 11 14 78.5
condition 3 5 60.0
subroutine 12 13 92.3
pod 0 3 0.0
total 89 101 88.1


line stmt bran cond sub pod time code
1             package Path::Hilbert::BigInt;
2              
3 1     1   330 use strict;
  1         2  
  1         39  
4 1     1   5 use warnings;
  1         2  
  1         20  
5 1     1   19 use 5.012;
  1         12  
  1         25  
6 1     1   3 use utf8;
  1         2  
  1         7  
7              
8 1     1   737 use Math::BigRat try => 'GMP,Pari,Calc';
  1         849394  
  1         5  
9 1     1   1434 use Math::BigInt try => 'GMP,Pari,Calc';
  1         2  
  1         3  
10              
11 1     1   686 use Exporter qw( import );
  1         1  
  1         812  
12              
13             our @EXPORT = qw( xy2d d2xy );
14              
15             our $VERSION = '1.204';
16              
17             # optional constructor if you want OO-style
18             sub new {
19 0     0 0 0 my $class = shift;
20 0         0 my ($n) = @_;
21 0         0 return bless { n => $n } => $class;
22             }
23              
24             # convert (x,y) to d
25             sub xy2d {
26 1360     1360 0 147215 my ($side, $x, $y) = @_;
27 1360         4001 my $n = _valid_n($side);
28 1360         34568 ($x, $y) = map { Math::BigInt->new("$_") } ($x, $y);
  2720         40310  
29 1360         36821 my $d = Math::BigInt->bzero();
30 1360         22067 for (my $s = $n->copy()->brsft(1); $s->bcmp(0) > 0; $s->brsft(1)) {
31 19720 100       3784131 my $rx = Math::BigInt->new($x->copy()->band($s)->bcmp(0) > 0 ? "1" : "0");
32 19720 100       4169892 my $ry = Math::BigInt->new($y->copy()->band($s)->bcmp(0) > 0 ? "1" : "0");
33 19720         4155960 my $three_rx = $rx->copy()->bmul("3");
34 19720         1796538 my $s_squared = $s->copy()->bpow("2");
35 19720         2342122 $d->badd($s_squared->bmul($three_rx->bxor($ry)));
36 19720         2057047 ($x, $y) = _rot($s, $x, $y, $rx, $ry);
37             }
38 1360         267122 return Math::BigRat->new($d);
39             }
40              
41             # convert d to (x,y)
42             sub d2xy {
43 1360     1360 0 5292 my ($side, $d) = @_;
44 1360         3739 my $n = _valid_n($side);
45 1360         44116 my $t = Math::BigInt->new($d);
46 1360         29394 my ($x, $y) = map { Math::BigInt->bzero() } (1 .. 2);
  2720         33110  
47 1360         20635 for (my $s = Math::BigInt->bone(); $s->bcmp($n) < 0; $s->blsft(1)) {
48 19720         3586023 my $rx = $t->copy()->brsft(1)->band(Math::BigInt->bone());
49 19720         2974441 my $ry = $t->copy()->bxor($rx)->band(Math::BigInt->bone());
50 19720         2111600 ($x, $y) = _rot($s, $x, $y, $rx, $ry);
51 19720         42382 my $Dx = $s->copy()->bmul($rx);
52 19720         946276 my $Dy = $s->copy()->bmul($ry);
53 19720 50       843264 $Dx >= 0 ? $x->badd($Dx) : $x->bsub($Dx->copy()->babs());
54 19720 50       2538679 $Dy >= 0 ? $y->badd($Dy) : $y->bsub($Dy->copy()->babs());
55 19720         2452420 $t->brsft(2);
56             }
57 1360         251504 return map { Math::BigRat->new($_) } ($x, $y);
  2720         153057  
58             }
59              
60             # rotate/flip a quadrant appropriately
61             sub _rot {
62 39440     39440   49262 my ($n, $x, $y, $rx, $ry) = @_;
63 39440 100       95226 if (!$ry) {
64 36134 100       758305 if ($rx > 0) {
65 1224         125916 $x = $n - 1 - $x;
66 1224         235920 $y = $n - 1 - $y;
67             }
68 36134         3641159 ($x, $y) = ($y, $x);
69             }
70 39440         201681 return ($x, $y);
71             }
72              
73             sub _valid_n {
74 2720     2720   6965 my $n = _extract_side(shift(@_));
75 2720   100     4310 $n = 2 ** int((eval { (log($n) / log(2)) } || 0) + 0.5);
76 2720         10680 return Math::BigInt->new(int($n));
77             }
78              
79             sub _extract_side {
80 2720     2720   3507 my ($side) = @_;
81 2720 50 33     9587 $side = $side->{ n } if ref($side) eq 'HASH' && exists $side->{ n };
82 2720         4614 return $side;
83             }
84              
85             1;
86              
87             __END__