File Coverage

blib/lib/Math/PlanePath/HexSpiralSkewed.pm
Criterion Covered Total %
statement 100 126 79.3
branch 16 24 66.6
condition 1 2 50.0
subroutine 22 24 91.6
pod 4 4 100.0
total 143 180 79.4


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 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
6             # it under the terms of the GNU General Public License as published by the
7             # Free 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             package Math::PlanePath::HexSpiralSkewed;
20 2     2   1671 use 5.004;
  2         8  
21 2     2   10 use strict;
  2         3  
  2         89  
22             #use List::Util 'max';
23             *max = \&Math::PlanePath::_max;
24              
25 2     2   11 use vars '$VERSION', '@ISA';
  2         4  
  2         123  
26             $VERSION = 129;
27 2     2   727 use Math::PlanePath;
  2         6  
  2         87  
28             *_sqrtint = \&Math::PlanePath::_sqrtint;
29             @ISA = ('Math::PlanePath');
30              
31 2     2   540 use Math::PlanePath::HexSpiral;
  2         6  
  2         65  
32             use Math::PlanePath::Base::Generic
33 2     2   13 'round_nearest';
  2         3  
  2         90  
34              
35             # uncomment this to run the ### lines
36             #use Devel::Comments;
37              
38              
39 2     2   12 use Math::PlanePath::SquareSpiral;
  2         5  
  2         102  
40             *parameter_info_array = \&Math::PlanePath::SquareSpiral::parameter_info_array;
41 2     2   13 use constant xy_is_visited => 1;
  2         4  
  2         120  
42              
43 2     2   14 use constant dx_minimum => -1;
  2         3  
  2         84  
44 2     2   10 use constant dx_maximum => 1;
  2         4  
  2         109  
45 2     2   13 use constant dy_minimum => -1;
  2         4  
  2         89  
46 2     2   12 use constant dy_maximum => 1;
  2         4  
  2         222  
47              
48 2         182 use constant 1.02 _UNDOCUMENTED__dxdy_list => (1,0, # E four plus
49             0,1, # N NW and SE
50             -1,1, # NW
51             -1,0, # W
52             0,-1, # S
53             1,-1, # SE
54 2     2   15 );
  2         26  
55             *x_negative_at_n = \&Math::PlanePath::HexSpiral::x_negative_at_n;
56             *y_negative_at_n
57             = \&Math::PlanePath::HexSpiral::y_negative_at_n;
58             *_UNDOCUMENTED__dxdy_list_at_n
59             = \&Math::PlanePath::HexSpiral::_UNDOCUMENTED__dxdy_list_at_n;
60              
61 2     2   13 use constant dsumxy_minimum => -1; # W,S straight
  2         4  
  2         99  
62 2     2   13 use constant dsumxy_maximum => 1; # N,E straight
  2         3  
  2         174  
63 2     2   14 use constant ddiffxy_minimum => -2; # NW diagonal
  2         4  
  2         85  
64 2     2   11 use constant ddiffxy_maximum => 2; # SE diagonal
  2         15  
  2         111  
65 2     2   14 use constant dir_maximum_dxdy => (1,-1); # South-East
  2         4  
  2         117  
66              
67 2     2   13 use constant turn_any_right => 0; # only left or straight
  2         13  
  2         1649  
68             sub _UNDOCUMENTED__turn_any_left_at_n {
69 0     0   0 my ($self) = @_;
70 0         0 return $self->n_start + $self->{'wider'} + 1;
71             }
72              
73              
74             #------------------------------------------------------------------------------
75              
76             sub new {
77 5     5 1 648 my $self = shift->SUPER::new (@_);
78              
79             # parameters
80 5   50     33 $self->{'wider'} ||= 0; # default
81 5 100       14 if (! defined $self->{'n_start'}) {
82 3         18 $self->{'n_start'} = $self->default_n_start;
83             }
84              
85 5         12 return $self;
86             }
87              
88             # Same as HexSpiral, but diagonal down and to the left is the downwards
89             # vertical at x=-$w_left.
90              
91             sub n_to_xy {
92 46     46 1 497 my ($self, $n) = @_;
93             ### HexSpiralSkewed n_to_xy(): $n
94              
95 46         78 $n = $n - $self->{'n_start'}; # N=0 basis
96 46 50       84 if ($n < 0) { return; }
  0         0  
97              
98 46         74 my $w = $self->{'wider'};
99 46         71 my $w_right = int($w/2);
100 46         73 my $w_left = $w - $w_right;
101             #### $w
102             #### $w_left
103             #### $w_right
104              
105 46         117 my $d = int((_sqrtint(3*$n + ($w+2)*$w + 1) - 1 - $w) / 3);
106             #### d frac: (_sqrtint(3*$n + ($w+2)*$w + 1) - 1 - $w) / 3
107             #### $d
108 46         86 $n -= (3*$d + 2 + 2*$w)*$d + 1;
109             #### remainder: $n
110              
111 46         63 $n += 1; # N=1 basis
112              
113 46 100       89 if ($n <= $d+1+$w) {
114             #### bottom horizontal
115 22         71 return ($n - $w_left,
116             -$d);
117             }
118 24         38 $n -= $d+1+$w;
119 24 100       42 if ($n <= $d) {
120             #### right lower vertical, being 1 shorter: $n
121 4         12 return ($d + 1 + $w_right,
122             $n - $d);
123             }
124 20         25 $n -= $d;
125 20 100       41 if ($n <= $d+1) {
126             #### right upper diagonal: $n
127 6         14 return (-$n + $d + 1 + $w_right,
128             $n);
129             }
130 14         17 $d = $d + 1; # no warnings if $d==infinity
131 14         21 $n -= $d;
132 14 100       27 if ($n <= $d+$w) {
133             #### top horizontal
134 6         15 return (-$n + $w_right,
135             $d);
136             }
137 8         96 $n -= $d+$w;
138 8 100       18 if ($n <= $d) {
139             #### left upper vertical
140 6         16 return (-$d - $w_left,
141             -$n + $d);
142             }
143             #### left lower diagonal
144 2         6 $n -= $d;
145 2         6 return ($n - $d - $w_left,
146             -$n);
147             }
148              
149             sub xy_to_n {
150 4     4 1 299 my ($self, $x, $y) = @_;
151             ### xy_to_n(): "$x, $y"
152              
153 4         13 $x = round_nearest ($x);
154 4         11 $y = round_nearest ($y);
155              
156 4         9 my $w = $self->{'wider'};
157 4         7 my $w_right = int($w/2);
158 4         6 my $w_left = $w - $w_right;
159              
160 4 50       9 if ($y > 0) {
161 0         0 $x -= $w_right;
162 0 0       0 if ($x < -$y-$w) {
163             ### left upper vertical
164 0         0 my $d = -$x - $w;
165             ### $d
166             ### base: (3*$d + 1 + 2*$w)*$d
167             return ((3*$d + 1 + 2*$w)*$d
168             - $y
169 0         0 + $self->{'n_start'});
170             } else {
171 0         0 my $d = $y + max($x,0);
172             ### right upper diagonal and top horizontal
173             ### $d
174             ### base: (3*$d - 1 + 2*$w)*$d - $w
175             return ((3*$d - 1 + 2*$w)*$d - $w
176             - $x
177 0         0 + $self->{'n_start'});
178             }
179              
180             } else {
181             # $y < 0
182 4         7 $x += $w_left;
183 4 100       9 if ($x-$w <= -$y) {
184 2         7 my $d = -$y + max(-$x,0);
185             ### left lower diagonal and bottom horizontal
186             ### $d
187             ### base: (3*$d + 2 + 2*$w)*$d + 1
188             return ((3*$d + 2 + 2*$w)*$d
189             + $x
190 2         7 + $self->{'n_start'});
191             } else {
192             ### right lower vertical
193 2         76 my $d = $x - $w;
194             ### $d
195             ### base: (3*$d - 2 + 2*$w)*$d + 1 - $w
196             return ((3*$d - 2 + 2*$w)*$d - $w
197             + $y
198 2         9 + $self->{'n_start'});
199             }
200             }
201             }
202              
203             # not exact
204             sub rect_to_n_range {
205 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
206             ### HexSpiralSkewed rect_to_n_range(): $x1,$y1, $x2,$y2
207              
208 0           $x1 = round_nearest ($x1);
209 0           $y1 = round_nearest ($y1);
210 0           $x2 = round_nearest ($x2);
211 0           $y2 = round_nearest ($y2);
212              
213 0           my $w = $self->{'wider'};
214 0           my $w_right = int($w/2);
215 0           my $w_left = $w - $w_right;
216              
217 0           my $d = 0;
218 0           foreach my $x ($x1, $x2) {
219 0           $x += $w_left;
220 0 0         if ($x >= $w) {
221 0           $x -= $w;
222             }
223 0           foreach my $y ($y1, $y2) {
224 0 0         $d = max ($d,
225             (($y > 0) == ($x > 0)
226             ? abs($x) + abs($y) # top right or bottom left diagonals
227             : max(abs($x),abs($y)))); # top left or bottom right squares
228             }
229             }
230 0           $d += 1;
231              
232             # diagonal downwards bottom right being the end of a revolution
233             # s=0
234             # s=1 n=7
235             # s=2 n=19
236             # s=3 n=37
237             # s=4 n=61
238             # n = 3*$d*$d + 3*$d + 1
239             #
240             ### gives: "sum $d is " . (3*$d*$d + 3*$d + 1)
241              
242             # ENHANCE-ME: find actual minimum if rect doesn't cover 0,0
243             return ($self->{'n_start'},
244 0           (3*$d + 3 + 2*$self->{'wider'})*$d + $self->{'n_start'});
245             }
246              
247             1;
248             __END__