File Coverage

blib/lib/Math/PlanePath/TriangleSpiral.pm
Criterion Covered Total %
statement 57 91 62.6
branch 1 12 8.3
condition 0 9 0.0
subroutine 19 25 76.0
pod 6 6 100.0
total 83 143 58.0


line stmt bran cond sub pod time code
1             # Copyright 2010, 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
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::TriangleSpiral;
20 1     1   730 use 5.004;
  1         3  
21 1     1   4 use strict;
  1         2  
  1         29  
22             #use List::Util 'max';
23             *max = \&Math::PlanePath::_max;
24              
25 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         58  
26             $VERSION = 128;
27 1     1   512 use Math::PlanePath;
  1         2  
  1         31  
28             @ISA = ('Math::PlanePath');
29              
30             use Math::PlanePath::Base::Generic
31 1     1   5 'round_nearest';
  1         1  
  1         49  
32             *_sqrtint = \&Math::PlanePath::_sqrtint;
33              
34             # uncomment this to run the ### lines
35             #use Smart::Comments;
36              
37              
38             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_even;
39 1         104 use constant parameter_info_array =>
40 1     1   5 [ Math::PlanePath::Base::Generic::parameter_info_nstart1() ];
  1         1  
41              
42             sub x_negative_at_n {
43 0     0 1 0 my ($self) = @_;
44 0         0 return $self->n_start + 4;
45             }
46             sub y_negative_at_n {
47 0     0 1 0 my ($self) = @_;
48 0         0 return $self->n_start + 6;
49             }
50             sub _UNDOCUMENTED__dxdy_list_at_n {
51 0     0   0 my ($self) = @_;
52 0         0 return $self->n_start + 3;
53             }
54 1     1   6 use constant dx_minimum => -1;
  1         1  
  1         37  
55 1     1   4 use constant dx_maximum => 2;
  1         1  
  1         30  
56 1     1   4 use constant dy_minimum => -1;
  1         2  
  1         43  
57 1     1   5 use constant dy_maximum => 1;
  1         1  
  1         91  
58 1         50 use constant 1.02 _UNDOCUMENTED__dxdy_list => (2,0, # E
59             -1,1, # NW
60 1     1   6 -1,-1); # SW
  1         10  
61 1     1   5 use constant absdx_minimum => 1;
  1         1  
  1         44  
62 1     1   6 use constant dsumxy_minimum => -2; # SW diagonal
  1         1  
  1         40  
63 1     1   6 use constant dsumxy_maximum => 2; # dX=+2 horiz
  1         1  
  1         39  
64 1     1   5 use constant ddiffxy_minimum => -2; # NW diagonal
  1         1  
  1         32  
65 1     1   4 use constant ddiffxy_maximum => 2; # dX=+2 horiz
  1         1  
  1         40  
66 1     1   5 use constant dir_maximum_dxdy => (-1,-1); # at most South-West diagonal
  1         1  
  1         34  
67              
68 1     1   4 use constant turn_any_right => 0; # only left or straight
  1         2  
  1         410  
69              
70              
71             #------------------------------------------------------------------------------
72              
73             sub new {
74 1     1 1 8 my $self = shift->SUPER::new (@_);
75 1 50       7 if (! defined $self->{'n_start'}) {
76 1         8 $self->{'n_start'} = $self->default_n_start;
77             }
78 1         3 return $self;
79             }
80              
81             # base at bottom right corner
82             # d = [ 1, 2, 3 ]
83             # n = [ 2, 11, 29 ]
84             # $d = 1/2 + sqrt(2/9 * $n + -7/36)
85             # = 1/2 + sqrt(8/36 * $n + -7/36)
86             # = 0.5 + sqrt(8*$n + -7)/6
87             # = (1 + 2*sqrt(8*$n + -7)/6) / 2
88             # = (1 + sqrt(8*$n + -7)/3) / 2
89             # = (3 + sqrt(8*$n - 7)) / 6
90             #
91             # $n = (9/2*$d**2 + -9/2*$d + 2)
92             # = (4.5*$d - 4.5)*$d + 2
93             #
94             # top of pyramid
95             # d = [ 1, 2, 3 ]
96             # n = [ 4, 16, 37 ]
97             # $n = (9/2*$d**2 + -3/2*$d + 1)
98             # so remainder from there
99             # rem = $n - (9/2*$d**2 + -3/2*$d + 1)
100             # = $n - (4.5*$d*$d - 1.5*$d + 1)
101             # = $n - ((4.5*$d - 1.5)*$d + 1)
102             #
103             #
104             sub n_to_xy {
105 0     0 1   my ($self, $n) = @_;
106             #### TriangleSpiral n_to_xy: $n
107              
108 0           $n = $n - $self->{'n_start'}; # starting $n==0, warn if $n==undef
109 0 0         if ($n < 0) { return; }
  0            
110              
111 0           my $d = int ((3 + _sqrtint(8*$n+1)) / 6);
112             #### $d
113              
114 0           $n -= (9*$d - 3)*$d/2;
115             #### remainder: $n
116              
117 0 0         if ($n <= 3*$d) {
118             ### sides, remainder pos/neg from top
119 0           return (-$n,
120             2*$d - abs($n));
121             } else {
122             ### rightwards from bottom left
123             ### remainder: $n - 3*$d
124             # corner is x=-3*$d
125             # so -3*$d + 2*($n - 3*$d)
126             # = -3*$d + 2*$n - 6*$d
127             # = -9*$d + 2*$n
128             # = 2*$n - 9*$d
129 0           return (2*$n - 9*$d,
130             -$d);
131             }
132             }
133              
134             sub xy_to_n {
135 0     0 1   my ($self, $x, $y) = @_;
136 0           $x = round_nearest ($x);
137 0           $y = round_nearest ($y);
138             ### xy_to_n(): "$x,$y"
139              
140 0 0         if (($x ^ $y) & 1) {
141 0           return undef; # nothing on odd points
142             }
143              
144 0 0 0       if ($y < 0 && 3*$y <= $x && $x <= -3*$y) {
      0        
145             ### bottom horizontal
146             # negative y, at vertical x=0
147             # [ -1, -2, -3, -4, -5, -6 ]
148             # [ 8.5, 25, 50.5, 85, 128.5, 181 ]
149             # $n = (9/2*$y**2 + -3*$y + 1)
150             # = (4.5*$y*$y + -3*$y + 1)
151             # = ((4.5*$y -3)*$y + 1)
152             # from which $x/2
153             #
154 0           return ((9*$y - 6)*$y/2) + $x/2 + $self->{'n_start'};
155              
156             } else {
157             ### sides diagonal
158             #
159             # positive y, x=0 centres
160             # [ 2, 4, 6, 8 ]
161             # [ 4, 16, 37, 67 ]
162             # n = (9/8*$d**2 + -3/4*$d + 1)
163             # = (9/8*$d + -3/4)*$d + 1
164             # = (9*$d + - 6)*$d/8 + 1
165             # from which -$x offset
166             #
167 0           my $d = abs($x) + $y;
168 0           return ((9*$d - 6)*$d/8) - $x + $self->{'n_start'};
169             }
170             }
171              
172             # not exact
173             sub rect_to_n_range {
174 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
175              
176 0           $x1 = round_nearest ($x1);
177 0           $y1 = round_nearest ($y1);
178 0           $x2 = round_nearest ($x2);
179 0           $y2 = round_nearest ($y2);
180              
181 0           my $d = 0;
182 0           foreach my $x ($x1, $x2) {
183 0           foreach my $y ($y1, $y2) {
184 0 0 0       $d = max ($d,
185             1 + ($y < 0 && 3*$y <= $x && $x <= -3*$y
186             ? -$y # bottom horizontal
187             : int ((abs($x) + $y) / 2))); # sides
188             }
189             }
190             return ($self->{'n_start'},
191 0           (9*$d - 9)*$d/2 + $self->{'n_start'});
192             }
193              
194             1;
195             __END__