File Coverage

blib/lib/Math/PlanePath/AztecDiamondRings.pm
Criterion Covered Total %
statement 101 106 95.2
branch 29 30 96.6
condition n/a
subroutine 23 25 92.0
pod 6 6 100.0
total 159 167 95.2


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
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              
20             # cute groupings
21             # AztecDiamondRings, FibonacciWord fibonacci_word_type plain, 10x10 scale 15
22              
23              
24             package Math::PlanePath::AztecDiamondRings;
25 1     1   1008 use 5.004;
  1         2  
26 1     1   5 use strict;
  1         2  
  1         73  
27             #use List::Util 'min', 'max';
28             *min = \&Math::PlanePath::_min;
29             *max = \&Math::PlanePath::_max;
30              
31 1     1   6 use vars '$VERSION', '@ISA';
  1         1  
  1         56  
32             $VERSION = 127;
33 1     1   590 use Math::PlanePath;
  1         2  
  1         40  
34             @ISA = ('Math::PlanePath');
35             *_sqrtint = \&Math::PlanePath::_sqrtint;
36              
37             use Math::PlanePath::Base::Generic
38 1     1   5 'round_nearest';
  1         2  
  1         34  
39              
40             # uncomment this to run the ### lines
41             # use Smart::Comments;
42              
43              
44 1         38 use constant parameter_info_array =>
45             [
46             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
47 1     1   4 ];
  1         2  
48              
49 1     1   4 use constant n_frac_discontinuity => 0;
  1         1  
  1         31  
50 1     1   4 use constant xy_is_visited => 1;
  1         1  
  1         77  
51              
52             sub x_negative_at_n {
53 0     0 1 0 my ($self) = @_;
54 0         0 return $self->n_start + 1;
55             }
56             sub y_negative_at_n {
57 0     0 1 0 my ($self) = @_;
58 0         0 return $self->n_start + 2;
59             }
60 1     1   6 use constant dx_minimum => -1;
  1         1  
  1         35  
61 1     1   4 use constant dx_maximum => 1;
  1         1  
  1         42  
62 1     1   5 use constant dy_minimum => -1;
  1         8  
  1         47  
63 1     1   5 use constant dy_maximum => 1;
  1         1  
  1         53  
64 1         40 use constant _UNDOCUMENTED__dxdy_list => (1,0, # E
65             1,1, # NE
66             # not North
67             -1,1, # NW
68             -1,0, # W
69             -1,-1, # SW
70             0,-1, # S
71 1     1   5 1,-1); # SE;
  1         1  
72 1     1   4 use constant dsumxy_minimum => -2; # diagonals
  1         2  
  1         40  
73 1     1   5 use constant dsumxy_maximum => 2;
  1         1  
  1         38  
74 1     1   5 use constant ddiffxy_minimum => -2;
  1         2  
  1         31  
75 1     1   4 use constant ddiffxy_maximum => 2;
  1         2  
  1         43  
76 1     1   5 use constant dir_maximum_dxdy => (1,-1); # South-East
  1         1  
  1         35  
77 1     1   4 use constant turn_any_right => 0; # only left or straight
  1         2  
  1         489  
78              
79              
80             #------------------------------------------------------------------------------
81              
82             sub new {
83 6     6 1 700 my $self = shift->SUPER::new(@_);
84 6 100       17 if (! defined $self->{'n_start'}) {
85 5         19 $self->{'n_start'} = $self->default_n_start;
86             }
87 6         9 return $self;
88             }
89              
90             # starting from X axis and n_start=0
91             # d = [ 1, 2, 3, 4, 5 ]
92             # n = [ 0,4,12,24,40 ]
93             # N = (2 d^2 - 2 d)
94             # = (2*$d**2 - 2*$d)
95             # = ((2*$d - 2)*$d)
96             # d = 1/2 + sqrt(1/2 * $n + 1/4)
97             # = (sqrt(2*$n+1) + 1)/2
98             #
99             # X negative axis
100             # d = [ 1, 2, 3, 4,5 ]
101             # n = [ 2, 8, 18, 32, 50 ]
102             # N = (2 d^2)
103              
104             sub n_to_xy {
105 115     115 1 6855 my ($self, $n) = @_;
106             #### n_to_xy: $n
107              
108             # adjust to N=0 at origin X=0,Y=0
109 115         170 $n = $n - $self->{'n_start'};
110 115 50       194 if ($n < 0) { return; }
  0         0  
111              
112 115         250 my $d = int( (_sqrtint(2*$n+1) + 1)/2 );
113 115         180 $n -= 2*$d*$d; # to $n=0 half way around at horiz Y=-1 X<-1
114              
115 115 100       186 if ($n < 0) {
116 82         108 my $x = -$d-$n-1;
117 82 100       115 if ($n < -$d) {
118             # top-right
119 40         75 return ($x,
120             min($n+2*$d, $d-1));
121             } else {
122             # top-left
123 42         64 return (max($x, -$d),
124             -1-$n);
125             }
126             } else {
127 33         38 my $x = $n-$d;
128 33 100       46 if ($n < $d) {
129             # bottom-left
130 17         20 my $y = -1-$n;
131 17         29 return ($x,
132             max($y, -$d));
133             } else {
134             # bottom-right
135 16         29 return (min($x, $d-1),
136             $n-2*$d);
137             }
138             }
139             }
140              
141             sub xy_to_n {
142 52     52 1 683 my ($self, $x, $y) = @_;
143             ### AztecDiamondRings xy_to_n(): "$x, $y"
144              
145 52         87 $x = round_nearest ($x);
146 52         93 $y = round_nearest ($y);
147              
148 52 100       113 if ($x >= 0) {
149 31         35 my $d = $x + abs($y);
150 31         67 return (2*$d + 2)*$d + $y + $self->{'n_start'};
151             }
152 21 100       27 if ($y >= 0) {
153 14         16 my $d = $y - $x;
154 14         41 return 2*$d*$d - 1 - $y + $self->{'n_start'};
155             } else {
156 7         8 my $d = $y + $x;
157 7         15 return (2*$d + 4)*$d + 1 - $y + $self->{'n_start'};
158             }
159             }
160              
161              
162             # | | x2>=-x1 |
163             # M---+ | M-------M | +---M
164             # | | | | | | | | |
165             # +---m | +----m--+ | m---+
166             # | | |
167             # -----+------ -------+------- -----+--------
168             # | | |
169             #
170             # | | |
171             # M---+ | M-------M y2>=-y1 | +---M
172             # | | | | | | | | |
173             # | m | | | | | m |
174             # -------+------ -------m------- -----+--------
175             # | | | | | | | | |
176             # M---+ | M-------M | +---M
177             # | | |
178             #
179             # | | |
180             # -----+------ -------+------- -----+--------
181             # | | |
182             # +---m | +--m----+ | m---+
183             # | | | | | | | | |
184             # M---+ | M-------M | +---M
185             # | | |
186              
187             # exact
188             sub rect_to_n_range {
189 22     22 1 1433 my ($self, $x1,$y1, $x2,$y2) = @_;
190             ### AztecDiamondRings rect_to_n_range(): "$x1,$y1, $x2,$y2"
191              
192 22         60 $x1 = round_nearest ($x1);
193 22         32 $y1 = round_nearest ($y1);
194 22         33 $x2 = round_nearest ($x2);
195 22         36 $y2 = round_nearest ($y2);
196              
197 22 100       42 ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
198 22 100       31 ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
199              
200 22         25 my $min_x = 0;
201 22 100       41 my $min_y = ($y2 < 0 ? ($min_x = -1, $y2)
    100          
202             : $y1 > 0 ? $y1
203             : 0);
204 22 100       34 if ($x2 < $min_x) { $min_x = $x2 } # right edge if 0/-1 not covered
  4 100       6  
205 3         3 elsif ($x1 > $min_x) { $min_x = $x1 } # left edge if 0/-1 not covered
206              
207 22 100       34 my $max_y = ($y2 >= -$y1 ? $y2 : $y1);
208 22 100       28 my $max_x = ($x2 >= -$x1-($max_y<0) ? $x2 : $x1);
209              
210             ### min at: "$min_x, $min_y"
211             ### max at: "$max_x, $max_y"
212 22         38 return ($self->xy_to_n($min_x,$min_y),
213             $self->xy_to_n($max_x,$max_y));
214             }
215              
216             1;
217             __END__