File Coverage

blib/lib/Math/PlanePath/Staircase.pm
Criterion Covered Total %
statement 68 91 74.7
branch 5 22 22.7
condition 1 12 8.3
subroutine 18 19 94.7
pod 4 4 100.0
total 96 148 64.8


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 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::Staircase;
20 1     1   1180 use 5.004;
  1         6  
21 1     1   6 use strict;
  1         2  
  1         25  
22              
23 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         60  
24             $VERSION = 129;
25 1     1   742 use Math::PlanePath;
  1         3  
  1         61  
26             @ISA = ('Math::PlanePath');
27             *_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
28             *_sqrtint = \&Math::PlanePath::_sqrtint;
29              
30             use Math::PlanePath::Base::Generic
31 1     1   7 'round_nearest';
  1         2  
  1         41  
32              
33             # uncomment this to run the ### lines
34             #use Smart::Comments;
35              
36              
37 1     1   6 use constant class_x_negative => 0;
  1         1  
  1         48  
38 1     1   6 use constant class_y_negative => 0;
  1         2  
  1         42  
39 1     1   6 use constant n_frac_discontinuity => .5;
  1         1  
  1         52  
40             *xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;
41              
42 1     1   6 use constant dx_maximum => 1;
  1         1  
  1         64  
43 1     1   7 use constant dy_minimum => -1;
  1         2  
  1         49  
44 1     1   5 use constant dsumxy_minimum => -1; # straight S
  1         2  
  1         51  
45 1     1   7 use constant dsumxy_maximum => 2; # next row
  1         1  
  1         43  
46 1     1   5 use constant ddiffxy_maximum => 1; # straight S,E
  1         2  
  1         58  
47 1     1   7 use constant dir_maximum_dxdy => (0,-1); # South
  1         1  
  1         68  
48              
49 1         581 use constant parameter_info_array =>
50             [
51             Math::PlanePath::Base::Generic::parameter_info_nstart1(),
52 1     1   6 ];
  1         2  
53              
54              
55             #------------------------------------------------------------------------------
56              
57             sub new {
58 3     3 1 634 my $self = shift->SUPER::new(@_);
59 3 50       17 if (! defined $self->{'n_start'}) {
60 3         18 $self->{'n_start'} = $self->default_n_start;
61             }
62 3         7 return $self;
63             }
64              
65             # start from 0.5 back
66             # d = [ 0, 1, 2, 3 ]
67             # n = [ 1.5, 6.5, 15.5 ]
68             # n = ((2*$d - 1)*$d + 0.5)
69             # d = 1/4 + sqrt(1/2 * $n + -3/16)
70             #
71             # start from integer vertical
72             # d = [ 0, 1, 2, 3, 4 ]
73             # n = [ 1, 2, 7, 16, 29 ]
74             # n = ((2*$d - 1)*$d + 1)
75             # d = 1/4 + sqrt(1/2 * $n + -7/16)
76             # = [1 + sqrt(8*$n-7) ] / 4
77             #
78             sub n_to_xy {
79 25     25 1 2763 my ($self, $n) = @_;
80             #### Staircase n_to_xy: $n
81              
82             # adjust to N=1 start
83 25         51 $n = $n - $self->{'n_start'} + 1;
84              
85 25         36 my $d;
86             {
87 25         32 my $r = 8*$n - 3;
  25         47  
88 25 50       53 if ($r < 1) {
89 0         0 return; # N < 0.5, so before start of path
90             }
91 25         56 $d = int( (_sqrtint($r) + 1)/4 );
92             }
93             ### $d
94             ### base: ((2*$d - 1)*$d + 0.5)
95              
96 25         40 $n -= (2*$d - 1)*$d;
97             ### fractional: $n
98              
99 25         40 my $int = int($n);
100 25         33 $n -= $int;
101              
102 25         51 my $rem = _divrem_mutate ($int, 2);
103 25 100       45 if ($rem) {
104             ### down ...
105 14         48 return ($int,
106             -$n + 2*$d - $int);
107             } else {
108             ### across ...
109 11         38 return ($n + $int-1,
110             2*$d - $int);
111             }
112             }
113              
114             # d = [ 1 2, 3, 4 ]
115             # N = [ 2, 7, 16, 29 ]
116             # N = (2 d^2 - d + 1)
117             # and add 2*$d
118             # base = 2*d^2 - d + 1 + 2*d
119             # = 2*d^2 + d + 1
120             # = (2*$d + 1)*$d + 1
121             #
122             sub xy_to_n {
123 15     15 1 945 my ($self, $x, $y) = @_;
124              
125 15         32 $x = round_nearest ($x);
126 15         26 $y = round_nearest ($y);
127 15 50 33     57 if ($x < 0 || $y < 0) {
128 0         0 return undef;
129             }
130 15         32 my $d = int(($x + $y + 1) / 2);
131 15         39 return (2*$d + 1)*$d - $y + $x + $self->{'n_start'};
132             }
133              
134             # exact
135             sub rect_to_n_range {
136 0     0 1   my ($self, $x1,$y1, $x2,$y2) = @_;
137             ### Staircase rect_to_n_range(): "$x1,$y1 $x2,$y2"
138              
139 0           $x1 = round_nearest ($x1);
140 0           $y1 = round_nearest ($y1);
141 0           $x2 = round_nearest ($x2);
142 0           $y2 = round_nearest ($y2);
143              
144 0 0         if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # x2 > x1
  0            
145 0 0         if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # y2 > y1
  0            
146 0 0 0       if ($x2 < 0 || $y2 < 0) {
147 0           return (1, 0); # nothing outside first quadrant
148             }
149              
150 0 0         if ($x1 < 0) { $x1 *= 0; }
  0            
151 0 0         if ($y1 < 0) { $y1 *= 0; }
  0            
152 0           my $y_min = $y1;
153              
154 0 0 0       if ((($x1 ^ $y1) & 1) && $y1 < $y2) { # y2==y_max
155 0           $y1 += 1;
156             ### y1 inc: $y1
157             }
158 0 0 0       if (! (($x2 ^ $y2) & 1) && $y2 > $y_min) {
159 0           $y2 -= 1;
160             ### y2 dec: $y2
161             }
162 0           return ($self->xy_to_n($x1,$y1),
163             $self->xy_to_n($x2,$y2));
164             }
165              
166             1;
167             __END__