File Coverage

blib/lib/Math/PlanePath/DiamondArms.pm
Criterion Covered Total %
statement 112 113 99.1
branch 15 16 93.7
condition n/a
subroutine 27 27 100.0
pod 3 3 100.0
total 157 159 98.7


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath. If not, see .
17              
18              
19             # math-image --path=DiamondArms --lines --scale=10
20             # math-image --path=DiamondArms --all --output=numbers_dash
21             # math-image --path=DiamondArms --values=Polygonal,polygonal=8
22             #
23             # RepdigitsAnyBase fall on 14 or 15 lines ...
24             #
25              
26             package Math::PlanePath::DiamondArms;
27 1     1   1160 use 5.004;
  1         3  
28 1     1   7 use strict;
  1         2  
  1         62  
29             #use List::Util 'min', 'max';
30             *min = \&Math::PlanePath::_min;
31             *max = \&Math::PlanePath::_max;
32              
33 1     1   6 use vars '$VERSION', '@ISA';
  1         2  
  1         82  
34             $VERSION = 127;
35 1     1   731 use Math::PlanePath;
  1         3  
  1         57  
36             @ISA = ('Math::PlanePath');
37             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
38             *_sqrtint = \&Math::PlanePath::_sqrtint;
39              
40             use Math::PlanePath::Base::Generic
41 1     1   7 'round_nearest';
  1         1  
  1         38  
42 1     1   520 use Math::PlanePath::DiamondSpiral;
  1         2  
  1         30  
43              
44             # uncomment this to run the ### lines
45             #use Devel::Comments;
46              
47              
48 1     1   6 use constant arms_count => 4;
  1         2  
  1         49  
49 1     1   5 use constant xy_is_visited => 1;
  1         3  
  1         38  
50 1     1   5 use constant x_negative_at_n => 8;
  1         2  
  1         37  
51 1     1   5 use constant y_negative_at_n => 5;
  1         3  
  1         40  
52              
53 1     1   5 use constant dx_minimum => -1;
  1         2  
  1         37  
54 1     1   5 use constant dx_maximum => 1;
  1         2  
  1         51  
55 1     1   6 use constant dy_minimum => -1;
  1         2  
  1         40  
56 1     1   6 use constant dy_maximum => 1;
  1         12  
  1         66  
57 1         59 use constant _UNDOCUMENTED__dxdy_list => (1,1, # NE diagonals
58             -1,1, # NW
59             -1,-1, # SW
60 1     1   6 1,-1); # SE
  1         2  
61 1     1   6 use constant absdx_minimum => 1;
  1         2  
  1         41  
62 1     1   6 use constant absdy_minimum => 1;
  1         2  
  1         47  
63 1     1   6 use constant dsumxy_minimum => -2; # diagonals
  1         2  
  1         40  
64 1     1   5 use constant dsumxy_maximum => 2;
  1         1  
  1         49  
65 1     1   6 use constant ddiffxy_minimum => -2;
  1         2  
  1         52  
66 1     1   6 use constant ddiffxy_maximum => 2;
  1         2  
  1         41  
67 1     1   5 use constant dir_minimum_dxdy => (1,1); # North-East
  1         2  
  1         80  
68 1     1   7 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         2  
  1         44  
69 1     1   7 use constant turn_any_right => 0; # only left or straight
  1         2  
  1         566  
70              
71              
72             #------------------------------------------------------------------------------
73             # 28
74             # 172 +144
75             # 444 +272 +128
76             # 844 +400 +128
77              
78             # [ 0, 1, 2, 3,],
79             # [ 0, 1, 3, 6 ],
80             # N = (1/2 d^2 + 1/2 d)
81             # = (1/2*$d**2 + 1/2*$d)
82             # = ($d+1)*$d/2
83             # d = -1/2 + sqrt(2 * $n + 1/4)
84             # = (-1 + sqrt(8*$n + 1))/2
85              
86             sub n_to_xy {
87 512     512 1 64308 my ($self, $n) = @_;
88             ### DiamondArms n_to_xy(): $n
89 512 50       1202 if ($n < 1) {
90 0         0 return;
91             }
92 512         759 $n -= 1;
93 512         694 my $frac;
94             {
95 512         695 my $int = int($n);
  512         697  
96 512         722 $frac = $n - $int;
97 512         778 $n = $int; # BigFloat int() gives BigInt, use that
98             }
99              
100             # arm as initial rotation
101 512         1322 my $rot = _divrem_mutate($n,4);
102             ### $n
103              
104             # if (($rot%4) != 3) {
105             # return;
106             # }
107              
108 512         1270 my $d = int ((-1 + _sqrtint(8*$n+1)) / 2);
109             ### d frac: ((-1 + sqrt(8*$n + 1)) / 2)
110             ### $d
111             ### base: $d*($d+1)/2
112              
113 512         951 $n -= $d*($d+1)/2;
114             ### remainder: $n
115             ### assert: $n <= $d
116              
117 512         850 my $x = ($frac + $n) - $d;
118 512         796 my $y = - ($frac + $n);
119             ### unrot: "$x,$y"
120              
121 512         720 $rot = ($rot + $d) % 4;
122             ### $rot
123              
124 512 100       1115 if ($rot == 1) {
    100          
    100          
125 142         300 ($x,$y) = (1-$y, $x); # rotate +90 and right
126             } elsif ($rot == 2) {
127 111         206 ($x,$y) = (1-$x, 1-$y); # rotate 180 and up+right
128             } elsif ($rot == 3) {
129 114         205 ($x,$y) = ($y, 1-$x); # rotate +90 and up
130             }
131 512         1215 return ($x,$y);
132             }
133              
134             sub xy_to_n {
135 2556     2556 1 6229 my ($self, $x, $y) = @_;
136 2556         4582 $x = round_nearest ($x);
137 2556         4672 $y = round_nearest ($y);
138             ### DiamondArms xy_to_n: "$x,$y"
139              
140 2556         3517 my $rot = 0;
141             # eg. y=2 have (0<=>$y)-$y == -1-2 == -3
142 2556 100       4390 if ($y >= ($x > 0)) {
143             ### above horizontal, rot -180 ...
144 1385         1816 $rot = 2;
145 1385         1757 $x = 1-$x; # rotate 180 and offset
146 1385         1742 $y = 1-$y;
147             }
148 2556 100       4276 if ($x > 0) {
149             ### right of vertical, rot -90 ...
150 1546         1998 $rot++;
151 1546         2540 ($x,$y) = ($y,1-$x); # rotate -90 and offset
152             }
153              
154             # horizontal negative X axis
155             # d = -x + -y
156             # d=0 n=1
157             # d=4 n=41
158             # d=8 n=145
159             # d=12 n=313
160             # N = (2 d^2 + 2 d + 1)
161             # = (2*$d**2 + 2*$d + 1)
162             # = ((2*$d + 2)*$d + 1)
163             #
164 2556         3581 my $d = -$x - $y;
165             ### xy: "$x,$y"
166             ### $d
167             ### $rot
168             ### base: ((2*$d + 2)*$d + 1)
169             ### offset: -4 * $y
170             ### rot d mod: (($rot+$d+2) % 4)
171 2556         5832 return ((2*$d + 2)*$d + 1) - 4*$y + (($rot-$d) % 4);
172             }
173              
174              
175             # d = [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ],
176             # Nmax = [ 9, 25, 49, 81, 121, 169, 225, 289, 361 ]
177             # being the N=5 arm one spot before the corner of each run
178             # N = (4 d^2 + 4 d + 1)
179             # = (2d+1)^2
180             # = ((4*$d + 4)*$d + 1)
181             # or for d-1
182             # N = (4 d^2 - 4 d + 1)
183             # = (2d-1)^2
184             # = ((4*$d - 4)*$d + 1)
185             #
186             # not exact
187             sub rect_to_n_range {
188 512     512 1 28313 my ($self, $x1,$y1, $x2,$y2) = @_;
189 512         1313 $x1 = round_nearest ($x1);
190 512         1049 $y1 = round_nearest ($y1);
191 512         908 $x2 = round_nearest ($x2);
192 512         983 $y2 = round_nearest ($y2);
193 512 100       1596 my $x = (($x1<0) == ($x2<0) ? min(abs($x1),abs($x2)) : 0);
194 512 100       1282 my $y = (($y1<0) == ($y2<0) ? min(abs($y1),abs($y2)) : 0);
195 512         1104 my $d = max(0, $x + $y - 2);
196 512         1270 return (((2*$d + 2)*$d + 1),
197             max ($self->xy_to_n($x1,$y1),
198             $self->xy_to_n($x1,$y2),
199             $self->xy_to_n($x2,$y1),
200             $self->xy_to_n($x2,$y2)));
201             }
202              
203             1;
204             __END__