line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Path::Hilbert; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1073
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
57
|
|
4
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
59
|
|
5
|
2
|
|
|
2
|
|
54
|
use 5.012; |
|
2
|
|
|
|
|
10
|
|
6
|
2
|
|
|
2
|
|
1853
|
use utf8; |
|
2
|
|
|
|
|
21
|
|
|
2
|
|
|
|
|
11
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
69
|
use Exporter qw( import ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
341
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our @EXPORT = qw( xy2d d2xy ); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.205'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# optional constructor if you want OO-style |
15
|
|
|
|
|
|
|
sub new { |
16
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
17
|
0
|
|
|
|
|
0
|
my ($n) = @_; |
18
|
0
|
|
|
|
|
0
|
return bless { n => $n } => $class; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# convert (x,y) to d |
22
|
|
|
|
|
|
|
sub xy2d { |
23
|
1360
|
|
|
1360
|
1
|
5236
|
my ($side, $x, $y) = @_; |
24
|
1360
|
|
|
|
|
2367
|
my $n = _valid_n($side); |
25
|
1360
|
|
|
|
|
2127
|
my ($X, $Y) = map { int($_ + 0.5) } ($x, $y); |
|
2720
|
|
|
|
|
5515
|
|
26
|
1360
|
|
|
|
|
1886
|
my $D; |
27
|
|
|
|
|
|
|
{ |
28
|
2
|
|
|
2
|
|
1666
|
use integer; |
|
2
|
|
|
|
|
26
|
|
|
2
|
|
|
|
|
12
|
|
|
1360
|
|
|
|
|
1518
|
|
29
|
1360
|
|
|
|
|
1670
|
my $d = 0; |
30
|
1360
|
|
|
|
|
1778
|
my ($x, $y) = map { int($_) } ($X, $Y); |
|
2720
|
|
|
|
|
4372
|
|
31
|
1360
|
|
|
|
|
4001
|
for (my $s = $n / 2; $s > 0; $s /= 2) { |
32
|
19720
|
|
|
|
|
25979
|
my $rx = ($x & $s) > 0; |
33
|
19720
|
|
|
|
|
24478
|
my $ry = ($y & $s) > 0; |
34
|
19720
|
|
|
|
|
25655
|
$d += $s * $s * ((3 * $rx) ^ $ry); |
35
|
19720
|
|
|
|
|
38165
|
($x, $y) = _rot($s, $x, $y, $rx, $ry); |
36
|
|
|
|
|
|
|
} |
37
|
2
|
|
|
2
|
|
245
|
no integer; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
7
|
|
38
|
1360
|
|
|
|
|
2072
|
$D = $d; |
39
|
|
|
|
|
|
|
} |
40
|
1360
|
|
|
|
|
2513
|
return $D * _side_scale($side); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# convert d to (x,y) |
44
|
|
|
|
|
|
|
sub d2xy { |
45
|
4080
|
|
|
4080
|
1
|
3601068
|
my ($side, $d) = @_; |
46
|
4080
|
|
|
|
|
8856
|
my $n = _valid_n($side); |
47
|
4080
|
|
|
|
|
6951
|
my $T = int($d + 0.5); |
48
|
4080
|
|
|
|
|
4962
|
my ($X, $Y); |
49
|
|
|
|
|
|
|
{ |
50
|
2
|
|
|
2
|
|
233
|
use integer; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
7
|
|
|
4080
|
|
|
|
|
4857
|
|
51
|
4080
|
|
|
|
|
6369
|
my ($x, $y) = (0, 0); |
52
|
4080
|
|
|
|
|
6179
|
my $t = int($T); |
53
|
4080
|
|
|
|
|
11502
|
for (my $s = 1; $s < $n; $s *= 2) { |
54
|
59160
|
|
|
|
|
79223
|
my $rx = 1 & ($t / 2); |
55
|
59160
|
|
|
|
|
70017
|
my $ry = 1 & ($t ^ $rx); |
56
|
59160
|
|
|
|
|
103679
|
($x, $y) = _rot($s, $x, $y, $rx, $ry); |
57
|
59160
|
|
|
|
|
77834
|
$x += $s * $rx; |
58
|
59160
|
|
|
|
|
62502
|
$y += $s * $ry; |
59
|
59160
|
|
|
|
|
143731
|
$t /= 4; |
60
|
|
|
|
|
|
|
} |
61
|
2
|
|
|
2
|
|
234
|
no integer; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
9
|
|
62
|
4080
|
|
|
|
|
6704
|
($X, $Y) = ($x, $y); |
63
|
|
|
|
|
|
|
} |
64
|
4080
|
|
|
|
|
5831
|
return map { _side_scale($side) * $_ } ($X, $Y); |
|
8160
|
|
|
|
|
15613
|
|
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# rotate/flip a quadrant appropriately |
68
|
|
|
|
|
|
|
sub _rot { |
69
|
2
|
|
|
2
|
|
216
|
use integer; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
7
|
|
70
|
78880
|
|
|
78880
|
|
117857
|
my ($n, $x, $y, $rx, $ry) = map { int($_) } @_; |
|
394400
|
|
|
|
|
577181
|
|
71
|
78880
|
100
|
|
|
|
176269
|
if (!$ry) { |
72
|
72268
|
100
|
|
|
|
133012
|
if ($rx) { |
73
|
2448
|
|
|
|
|
3147
|
$x = $n - 1 - $x; |
74
|
2448
|
|
|
|
|
3176
|
$y = $n - 1 - $y; |
75
|
|
|
|
|
|
|
} |
76
|
72268
|
|
|
|
|
103686
|
($x, $y) = ($y, $x); |
77
|
|
|
|
|
|
|
} |
78
|
78880
|
|
|
|
|
164021
|
return ($x, $y); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _valid_n { |
82
|
14960
|
|
|
14960
|
|
27319
|
my $n = _extract_side(shift(@_)); |
83
|
2
|
|
|
2
|
|
253
|
no integer; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
12
|
|
84
|
14960
|
|
|
|
|
809042
|
my $rv = 2 ** int((log($n) / log(2)) + 0.5); |
85
|
2
|
|
|
2
|
|
97
|
use integer; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
7
|
|
86
|
14960
|
|
|
|
|
24897
|
return int($rv); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _extract_side { |
90
|
24480
|
|
|
24480
|
|
32467
|
my ($n) = @_; |
91
|
24480
|
50
|
|
|
|
50855
|
$n = $n->{ n } if ref($n); |
92
|
24480
|
|
|
|
|
39237
|
return $n; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub _side_scale { |
96
|
9520
|
|
|
9520
|
|
18144
|
my $side = _extract_side(shift(@_)); |
97
|
9520
|
|
|
|
|
17423
|
my $n = _valid_n($side); |
98
|
9520
|
|
|
|
|
31269
|
return $side / $n; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
1; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
__END__ |