File Coverage

blib/lib/Math/PlanePath/DiamondSpiral.pm
Criterion Covered Total %
statement 93 100 93.0
branch 25 28 89.2
condition n/a
subroutine 23 26 88.4
pod 6 6 100.0
total 147 160 91.8


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::DiamondSpiral;
20 2     2   1137 use 5.004;
  2         9  
21 2     2   11 use strict;
  2         15  
  2         53  
22              
23 2     2   10 use vars '$VERSION', '@ISA';
  2         4  
  2         132  
24             $VERSION = 128;
25 2     2   727 use Math::PlanePath;
  2         4  
  2         99  
26             *_sqrtint = \&Math::PlanePath::_sqrtint;
27             @ISA = ('Math::PlanePath');
28              
29             use Math::PlanePath::Base::Generic
30 2     2   12 'round_nearest';
  2         5  
  2         110  
31              
32             # uncomment this to run the ### lines
33             #use Smart::Comments;
34              
35 2     2   13 use constant xy_is_visited => 1;
  2         3  
  2         107  
36 2         226 use constant parameter_info_array =>
37 2     2   11 [ Math::PlanePath::Base::Generic::parameter_info_nstart1() ];
  2         3  
38              
39             sub x_negative_at_n {
40 0     0 1 0 my ($self) = @_;
41 0         0 return $self->n_start + 3;
42             }
43             sub y_negative_at_n {
44 0     0 1 0 my ($self) = @_;
45 0         0 return $self->n_start + 4;
46             }
47 2     2   13 use constant dx_minimum => -1;
  2         4  
  2         118  
48 2     2   13 use constant dx_maximum => 1;
  2         12  
  2         101  
49 2     2   12 use constant dy_minimum => -1;
  2         4  
  2         91  
50 2     2   14 use constant dy_maximum => 1;
  2         4  
  2         130  
51 2         193 use constant 1.02 _UNDOCUMENTED__dxdy_list => (1,0, # E N=1 and other bottom
52             1,1, # NE N=6
53             -1,1, # NW N=2
54             -1,-1, # SW N=3
55 2     2   13 1,-1); # SE N=4
  2         26  
56             sub _UNDOCUMENTED__dxdy_list_at_n {
57 0     0   0 my ($self) = @_;
58 0         0 return $self->n_start + 5;
59             }
60 2     2   12 use constant absdx_minimum => 1;
  2         4  
  2         114  
61 2     2   12 use constant dsumxy_minimum => -2; # diagonals
  2         4  
  2         100  
62 2     2   18 use constant dsumxy_maximum => 2;
  2         10  
  2         99  
63 2     2   12 use constant ddiffxy_minimum => -2;
  2         4  
  2         99  
64 2     2   12 use constant ddiffxy_maximum => 2;
  2         4  
  2         97  
65 2     2   12 use constant dir_maximum_dxdy => (1,-1); # South-East
  2         4  
  2         112  
66              
67 2     2   13 use constant turn_any_right => 0; # only left or straight
  2         4  
  2         1002  
68              
69              
70             #------------------------------------------------------------------------------
71             sub new {
72 4     4 1 696 my $self = shift->SUPER::new (@_);
73 4 50       49 if (! defined $self->{'n_start'}) {
74 4         23 $self->{'n_start'} = $self->default_n_start;
75             }
76 4         11 return $self;
77             }
78              
79             # start cycle at the vertical downwards from x=1,y=0
80             # s = [ 0, 1, 2, 3 ]
81             # n = [ 2, 6, 14,26 ]
82             # n = 2*$s*$s - 2*$s + 2
83             # s = .5 + sqrt(.5*$n-.75)
84             #
85             # then top of the diamond at 2*$s - 1
86             # so n - (2*$s*$s - 2*$s + 2 + 2*$s - 1)
87             # n - (2*$s*$s + 1)
88             #
89             # gives y=$s - n
90             # then x=$s-abs($y) on the right or x=-$s+abs($y) on the left
91             #
92             sub n_to_xy {
93 18     18 1 1719 my ($self, $n) = @_;
94             #### n_to_xy: $n
95              
96 18         33 $n = $n - $self->{'n_start'}; # starting $n==0, and warn if $n==undef
97 18 100       41 if ($n < 1) {
98 1 50       6 if ($n < 0) { return; }
  0         0  
99 1         3 return ($n, 0);
100             }
101              
102 17         50 my $d = int ( (1 + _sqrtint(2*$n-1)) / 2 );
103             #### $d
104             #### d frac: ( (1 + _sqrtint(2*$n-1)) / 2 )
105             #### base: 2*$d*$d - 2*$d + 2
106             #### extra: 2*$d - 1
107             #### sub: 2*$d*$d +1
108              
109 17         28 $n -= 2*$d*$d;
110             ### rem from top: $n
111              
112 17         31 my $y = -abs($n) + $d; # y=+$d at the top, down to y=-$d
113 17         24 my $x = abs($y) - $d; # 0 to $d on the right
114             #### uncapped y: $y
115             #### abs x: $x
116              
117             # cap for horiz at 5 to 6, 13 to 14 etc
118 17         24 $d = -$d;
119 17 100       30 if ($y < $d) { $y = $d; }
  4         9  
120              
121 17 100       59 return (($n >= 0 ? $x : -$x), # negate if on the right
122             $y);
123             }
124              
125             sub xy_to_n {
126 28     28 1 1101 my ($self, $x, $y) = @_;
127 28         59 $x = round_nearest ($x);
128 28         54 $y = round_nearest ($y);
129 28         42 my $d = abs($x) + abs($y);
130              
131             # vertical along the y>=0 axis
132             # s=0 n=1
133             # s=1 n=3
134             # s=2 n=9
135             # s=3 n=19
136             # s=4 n=33
137             # n = 2*$d*$d + 1
138             #
139 28         44 my $n = 2*$d*$d;
140              
141             # then +/- $d to go to left or right x axis, and -/+ $y from there
142 28 100       48 if ($x > 0) {
143             ### right quad 1 and 4
144 9         24 return $n - $d + $y + $self->{'n_start'};
145             } else {
146             # left quads 2 and 3
147 19         45 return $n + $d - $y + $self->{'n_start'};
148             }
149             }
150              
151             # | | x2>=-x1 |
152             # M---+ | M-------M | +---M
153             # | | | | | | | | |
154             # +---m | +----m--+ | m---+
155             # | | |
156             # -----+------ -------+------- -----+--------
157             # | | |
158             #
159             # | | |
160             # M---+ | M-------M y2>=-y1 | +---M
161             # | | | | | | | | |
162             # | m | | | | | m |
163             # -------+------ -------m------- -----+--------
164             # | | | | | | | | |
165             # M---+ | M-------M | +---M
166             # | | |
167             #
168             # | | |
169             # -----+------ -------+------- -----+--------
170             # | | |
171             # +---m | +--m----+ | m---+
172             # | | | | | | | | |
173             # M---+ | M-------M | +---M
174             # | | |
175              
176             # exact
177             sub rect_to_n_range {
178 5     5 1 430 my ($self, $x1,$y1, $x2,$y2) = @_;
179             ### DiamondSpiral rect_to_n_range(): "$x1,$y1, $x2,$y2"
180              
181 5         13 $x1 = round_nearest ($x1);
182 5         10 $y1 = round_nearest ($y1);
183 5         11 $x2 = round_nearest ($x2);
184 5         11 $y2 = round_nearest ($y2);
185              
186 5 100       11 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
187 5 50       10 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
188              
189 5 100       15 my $min_x = ($x2 < 0 ? $x2
    100          
190             : $x1 > 0 ? $x1
191             : 0);
192 5 100       13 my $min_y = ($y2 < 0 ? $y2
    100          
193             : $y1 > 0 ? $y1
194             : 0);
195              
196 5 100       10 my $max_x = ($x2 > -$x1 ? $x2 : $x1);
197 5 100       10 my $max_y = ($y2 >= -$y1+($max_x<=0) ? $y2 : $y1);
198              
199 5         19 return ($self->xy_to_n($min_x,$min_y),
200             $self->xy_to_n($max_x,$max_y));
201             }
202              
203             1;
204             __END__