File Coverage

blib/lib/Math/PlanePath/SquareArms.pm
Criterion Covered Total %
statement 46 90 51.1
branch 6 24 25.0
condition 2 6 33.3
subroutine 12 15 80.0
pod 3 3 100.0
total 69 138 50.0


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 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=SquareArms --lines --scale=10
20             # math-image --path=SquareArms --all --output=numbers_dash
21             # math-image --path=SquareArms --values=Polygonal,polygonal=8
22             #
23             # RepdigitsAnyBase fall on 14 or 15 lines ...
24             #
25              
26             package Math::PlanePath::SquareArms;
27 1     1   19 use 5.004;
  1         3  
28 1     1   7 use strict;
  1         2  
  1         50  
29             #use List::Util 'max';
30             *max = \&Math::PlanePath::_max;
31              
32 1     1   6 use vars '$VERSION', '@ISA';
  1         3  
  1         63  
33             $VERSION = 128;
34 1     1   8 use Math::PlanePath;
  1         2  
  1         28  
35 1     1   5 use Math::PlanePath::Base::NSEW;
  1         9  
  1         35  
36             @ISA = ('Math::PlanePath::Base::NSEW',
37             'Math::PlanePath');
38              
39             use Math::PlanePath::Base::Generic
40 1     1   6 'round_nearest';
  1         1  
  1         78  
41             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
42             *_sqrtint = \&Math::PlanePath::_sqrtint;
43              
44             # uncomment this to run the ### lines
45             #use Smart::Comments '###';
46              
47              
48 1     1   8 use constant arms_count => 4;
  1         2  
  1         63  
49 1     1   7 use constant xy_is_visited => 1;
  1         2  
  1         46  
50 1     1   6 use constant x_negative_at_n => 4;
  1         1  
  1         51  
51 1     1   7 use constant y_negative_at_n => 5;
  1         2  
  1         41  
52 1     1   5 use constant turn_any_right => 0; # only left or straight
  1         2  
  1         612  
53              
54              
55             #------------------------------------------------------------------------------
56              
57             # 28
58             # 172 +144
59             # 444 +272 +128
60             # 844 +400 +128
61              
62             # [ 0, 1, 2, 3,],
63             # [ 0, 2, 6, 12 ],
64             # N = (d^2 + d)
65             # d = -1/2 + sqrt(1 * $n + 1/4)
66             # = (-1 + 2*sqrt($n + 1/4)) / 2
67             # = (-1 + sqrt(4*$n + 1)) / 2
68              
69             sub n_to_xy {
70 0     0 1 0 my ($self, $n) = @_;
71             ### SquareArms n_to_xy(): $n
72              
73 0 0       0 if ($n < 2) {
74 0 0       0 if ($n < 1) { return; }
  0         0  
75             ### centre
76 0         0 return (0, 1-$n); # from n=1 towards n=5 at x=0,y=-1
77             }
78 0         0 $n -= 2;
79              
80 0         0 my $frac;
81 0         0 { my $int = int($n);
  0         0  
82 0         0 $frac = $n - $int;
83 0         0 $n = $int; # BigFloat int() gives BigInt, use that
84             }
85              
86             # arm as initial rotation
87 0         0 my $rot = _divrem_mutate($n,4);
88             ### $n
89              
90 0         0 my $d = int( (-1 + _sqrtint(4*$n+1)) / 2 );
91             ### d frac: ((-1 + sqrt(4*$n + 1)) / 2)
92             ### $d
93             ### base: $d*($d+1)
94              
95 0         0 $n -= $d*($d+1);
96             ### remainder: $n
97              
98 0         0 $rot += ($d % 4);
99 0         0 my $x = $d + 1;
100 0         0 my $y = $frac + $n - $d;
101              
102 0         0 $rot %= 4;
103 0 0       0 if ($rot & 2) {
104 0         0 $x = -$x; # rotate 180
105 0         0 $y = -$y;
106             }
107 0 0       0 if ($rot & 1) {
108 0         0 return (-$y,$x); # rotate +90
109             } else {
110 0         0 return ($x,$y);
111             }
112             }
113              
114             sub xy_to_n {
115 0     0 1 0 my ($self, $x, $y) = @_;
116 0         0 $x = round_nearest ($x);
117 0         0 $y = round_nearest ($y);
118             ### SquareArms xy_to_n: "$x,$y"
119              
120 0 0 0     0 if ($x == 0 && $y == 0) {
121 0         0 return 1;
122             }
123              
124 0         0 my $rot = 0;
125             # eg. y=2 have (0<=>$y)-$y == -1-2 == -3
126 0 0       0 if ($y <= ($x <=> 0) - $x) {
127             ### below diagonal, rot 180 ...
128 0         0 $rot = 2;
129 0         0 $x = -$x; # rotate 180
130 0         0 $y = -$y;
131             }
132 0 0       0 if ($x < $y) {
133             ### left of diagonal, rot -90 ...
134 0         0 $rot++;
135 0         0 ($x,$y) = ($y,-$x); # rotate -90
136             }
137              
138             # diagonal down from N=2
139             # x=1 d=0 n=2
140             # x=5 d=4 n=82
141             # x=9 d=8 n=290
142             # x=13 d=12 n=626
143             # N = (4 d^2 + 4 d + 2)
144             # = (4 x^2 - 4 x + 2)
145             # offset = y + x-1 upwards from diagonal
146             # N + 4*offset
147             # = (4*x^2 - 4*x + 2) + 4*(y + x-1)
148             # = 4*x^2 - 4*x + 2 + 4*y + 4*x - 4
149             # = 4*x^2 + 4*y - 2
150             # cf N=4*x^2 is on the X or Y axis, which is X axis after rotation
151             #
152             ### xy: "$x,$y"
153             ### $rot
154             ### x offset: $x-1 + $y
155             ### d mod: $d % 4
156             ### rot d mod: (($rot-$d) % 4)
157 0         0 return ($x*$x + $y)*4 - 2 + (($rot-$x+1) % 4);
158             }
159              
160             # d = [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ],
161             # Nmax = [ 9, 25, 49, 81, 121, 169, 225, 289, 361 ]
162             # being the N=5 arm one spot before the corner of each run
163             # N = (4 d^2 + 4 d + 1)
164             # = (2d+1)^2
165             # = ((4*$d + 4)*$d + 1)
166             # or for d-1
167             # N = (4 d^2 - 4 d + 1)
168             # = (2d-1)^2
169             # = ((4*$d - 4)*$d + 1)
170             #
171             # not exact
172             sub rect_to_n_range {
173 0     0 1 0 my ($self, $x1,$y1, $x2,$y2) = @_;
174 0         0 my ($d_lo, $d_hi) = _rect_square_range ($x1,$y1, $x2,$y2);
175 0         0 return (((4*$d_lo - 4)*$d_lo + 1),
176             max ($self->xy_to_n($x1,$y1),
177             $self->xy_to_n($x1,$y2),
178             $self->xy_to_n($x2,$y1),
179             $self->xy_to_n($x2,$y2)));
180             }
181              
182             sub _rect_square_range {
183 1400     1400   2107 my ($x1,$y1, $x2,$y2) = @_;
184             ### _rect_square_range(): "$x1,$y1 $x2,$y2"
185              
186 1400         2143 $x1 = round_nearest ($x1);
187 1400         2200 $y1 = round_nearest ($y1);
188 1400         2091 $x2 = round_nearest ($x2);
189 1400         1994 $y2 = round_nearest ($y2);
190              
191             # if x1,x2 opposite signs then origin x=0 covered, similarly y
192 1400         2033 my $x_zero_uncovered = ($x1<0) == ($x2<0);
193 1400         1669 my $y_zero_uncovered = ($y1<0) == ($y2<0);
194              
195 1400         2146 foreach ($x1,$y1, $x2,$y2) {
196 5600         6750 $_ = abs($_);
197             }
198             ### abs rect: "x=$x1 to $x2, y=$y1 to $y2"
199              
200 1400 50       2072 if ($x2 < $x1) { ($x1,$x2) = ($x2,$x1) } # swap to x1
  0         0  
201 1400 50       2072 if ($y2 < $y1) { ($y1,$y2) = ($y2,$y1) } # swap to y1
  0         0  
202              
203 1400 50       1889 my $dlo = ($x_zero_uncovered ? $x1 : 0);
204 1400 50 66     2935 if ($y_zero_uncovered && $dlo < $y1) { $dlo = $y1 }
  0         0  
205              
206 1400 100       2911 return ($dlo,
207             ($x2 > $y2 ? $x2 : $y2));
208             }
209              
210             1;
211             __END__