File Coverage

blib/lib/Math/PlanePath/TheodorusSpiral.pm
Criterion Covered Total %
statement 111 125 88.8
branch 13 20 65.0
condition 0 3 0.0
subroutine 27 28 96.4
pod 4 4 100.0
total 155 180 86.1


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::TheodorusSpiral;
20 1     1   1155 use 5.004;
  1         5  
21 1     1   5 use strict;
  1         2  
  1         24  
22 1     1   441 use Math::Libm 'hypot';
  1         3410  
  1         86  
23             #use List::Util 'max';
24             *max = \&Math::PlanePath::_max;
25              
26 1     1   8 use vars '$VERSION', '@ISA';
  1         2  
  1         64  
27             $VERSION = 129;
28 1     1   737 use Math::PlanePath;
  1         3  
  1         40  
29             @ISA = ('Math::PlanePath');
30              
31             use Math::PlanePath::Base::Generic
32 1         44 'is_infinite',
33 1     1   7 'round_nearest';
  1         2  
34              
35             # uncomment this to run the ### lines
36             #use Smart::Comments;
37              
38              
39 1     1   5 use constant n_start => 0;
  1         1  
  1         48  
40 1     1   4 use constant figure => 'circle';
  1         3  
  1         41  
41 1     1   5 use constant x_negative_at_n => 4;
  1         2  
  1         38  
42 1     1   5 use constant y_negative_at_n => 7;
  1         2  
  1         38  
43 1     1   5 use constant gcdxy_maximum => 1;
  1         2  
  1         51  
44 1     1   7 use constant dx_minimum => -1; # supremum when straight
  1         1  
  1         56  
45 1     1   6 use constant dx_maximum => 1; # at N=0
  1         2  
  1         58  
46 1     1   6 use constant dy_minimum => -1;
  1         2  
  1         42  
47 1     1   5 use constant dy_maximum => 1; # at N=1
  1         2  
  1         58  
48 1     1   6 use constant dsumxy_minimum => -sqrt(2); # supremum diagonal
  1         1  
  1         55  
49 1     1   6 use constant dsumxy_maximum => sqrt(2);
  1         2  
  1         46  
50 1     1   5 use constant ddiffxy_minimum => -sqrt(2); # supremum diagonal
  1         2  
  1         54  
51 1     1   6 use constant ddiffxy_maximum => sqrt(2);
  1         3  
  1         40  
52 1     1   5 use constant turn_any_right => 0; # left always
  1         2  
  1         63  
53 1     1   5 use constant turn_any_straight => 0; # left always
  1         2  
  1         57  
54              
55              
56             #------------------------------------------------------------------------------
57              
58             # This adding up of unit steps isn't very good. The last x,y,n is kept
59             # anticipating successively higher n, not necessarily consecutive, plus past
60             # x,y,n at _SAVE intervals for going backwards.
61             #
62             # The simplest formulas for the polar angle, possibly with the analytic
63             # continuation version don't seem much better, but theta approaches
64             # 2*sqrt(N) + const, or 2*sqrt(N) + 1/(6*sqrt(N+1)) + const + O(n^(3/2)), so
65             # more terms of that might have tolerably rapid convergence.
66             #
67             # The arctan sums for the polar angle end up as the generalized Riemann
68             # zeta, or the generalized minus the plain. Is there a good formula for
69             # that which would converge quickly?
70              
71 1     1   6 use constant 1.02; # for leading underscore
  1         14  
  1         22  
72 1     1   4 use constant _SAVE => 1000;
  1         2  
  1         674  
73              
74             my @save_n = (1);
75             my @save_x = (1);
76             my @save_y = (0);
77             my $next_save = _SAVE;
78              
79             sub new {
80 2     2 1 125 return shift->SUPER::new (i => 1,
81             x => 1,
82             y => 0,
83             @_);
84             }
85              
86             # r = sqrt(int)
87             # (frac r)^2
88             # = hypot(r, frac)^2 frac at right angle to radial
89             # = r^2 + $frac^2
90             # = sqrt(int)^2 + $frac^2
91             # = $int + $frac^2
92             #
93             sub n_to_rsquared {
94 10     10 1 204 my ($self, $n) = @_;
95 10 50       26 if ($n < 0) { return undef; }
  0         0  
96 10         19 my $int = int($n);
97 10         15 $n -= $int; # fractional part
98 10         46 return $n*$n + $int;
99             }
100              
101             # r = sqrt(i)
102             # x,y angle
103             # r*x/hypot, r*y/hypot
104             #
105             # newx = x - y/r
106             # newy = y + x/r
107             # (x-y/r)^2 + (y+x/r)^2
108             # = x^2 - 2y/r + y^2/r^2
109             # + y^2 + 2x/r + x^2/r^2
110              
111             sub n_to_xy {
112 10     10 1 474 my ($self, $n) = @_;
113             #### TheodorusSpiral n_to_xy(): $n
114              
115 10 50       25 if ($n < 0) { return; }
  0         0  
116 10 50       28 if (is_infinite($n)) { return ($n,$n); }
  0         0  
117              
118 10 100       26 if ($n < 1) {
119 2         7 return ($n, 0);
120             }
121 8         14 my $frac = $n;
122 8         12 $n = int($n);
123 8         11 $frac -= $n;
124              
125 8         19 my $i = $self->{'i'};
126 8         11 my $x = $self->{'x'};
127 8         14 my $y = $self->{'y'};
128             #### n_to_xy(): "$n from state $i $x,$y"
129              
130 8 100       17 if ($i > $n) {
131 2         8 for (my $pos = $#save_n; $pos >= 0; $pos--) {
132 5 100       14 if ($save_n[$pos] <= $n) {
133 2         5 $i = $save_n[$pos];
134 2         17 $x = $save_x[$pos];
135 2         5 $y = $save_y[$pos];
136 2         4 last;
137             }
138             }
139             ### resume: "$i $x,$y"
140             }
141              
142 8         20 while ($i < $n) {
143 3112         4064 my $r = sqrt($i);
144 3112         17742 ($x,$y) = ($x - $y/$r, $y + $x/$r);
145 6224         3842 $i++;
146              
147 6224 100       6182 if ($i == $next_save) {
148 2         6 push @save_n, $i;
149 2         4 push @save_x, $x;
150 2         4 push @save_y, $y;
151 2         6 $next_save += _SAVE;
152              
153             ### save: $i
154             ### @save_n
155             ### @save_x
156             ### @save_y
157             }
158             }
159              
160 3120         15 $self->{'i'} = $i;
161 3120         9 $self->{'x'} = $x;
162 3120         15 $self->{'y'} = $y;
163              
164 3120 100       17 if ($frac) {
165 3         5 my $r = sqrt($n);
166 3         17 return ($x - $frac*$y/$r,
167             $y + $frac*$x/$r);
168             } else {
169             #### integer return: "$i $x,$y"
170 3117         21 return ($x,$y);
171             }
172             }
173              
174             sub xy_to_n {
175 0     0 1   my ($self, $x, $y) = @_;
176             ### TheodorusSpiral xy_to_n(): "$x, $y"
177 0           my $r = hypot ($x,$y);
178 0           my $n_lo = int (max (0, $r - .51) ** 2);
179 0           my $n_hi = int (($r + .51) ** 2);
180             ### $n_lo
181             ### $n_hi
182              
183 0 0 0       if (is_infinite($n_lo) || is_infinite($n_hi)) {
184             ### infinite range, r inf or too big ...
185 0           return undef;
186             }
187              
188             # for(;;) loop since $n_lo..$n_hi limited to IV range
189 0           for (my $n = $n_lo; $n <= $n_hi; $n += 1) {
190 0           my ($nx,$ny) = $self->n_to_xy($n);
191             #### $n
192             #### $nx
193             #### $ny
194             #### hypot: hypot ($x-$nx,$y-$ny)
195 0 0         if (hypot ($x-$nx,$y-$ny) <= 0.5) {
196 0           return $n;
197             }
198             }
199 0           return undef;
200             }
201              
202 1     1   553 use Math::PlanePath::SacksSpiral;
  1         3  
  1         58  
203             # not exact
204             *rect_to_n_range = \&Math::PlanePath::SacksSpiral::rect_to_n_range;
205              
206             1;
207             __END__