| 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 |  |  |  |  |  |  | # Leading diagonal 2,8,18 = 2*d^2 | 
| 20 |  |  |  |  |  |  | # cf A185787 lists numerous seqs for rows,columns,diagonals | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | package Math::PlanePath::Diagonals; | 
| 24 | 3 |  |  | 3 |  | 4122 | use 5.004; | 
|  | 3 |  |  |  |  | 11 |  | 
| 25 | 3 |  |  | 3 |  | 20 | use strict; | 
|  | 3 |  |  |  |  | 45 |  | 
|  | 3 |  |  |  |  | 86 |  | 
| 26 | 3 |  |  | 3 |  | 17 | use Carp 'croak'; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 205 |  | 
| 27 |  |  |  |  |  |  | #use List::Util 'max'; | 
| 28 |  |  |  |  |  |  | *max = \&Math::PlanePath::_max; | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 3 |  |  | 3 |  | 28 | use vars '$VERSION', '@ISA'; | 
|  | 3 |  |  |  |  | 10 |  | 
|  | 3 |  |  |  |  | 277 |  | 
| 31 |  |  |  |  |  |  | $VERSION = 128; | 
| 32 | 3 |  |  | 3 |  | 729 | use Math::PlanePath; | 
|  | 3 |  |  |  |  | 15 |  | 
|  | 3 |  |  |  |  | 135 |  | 
| 33 |  |  |  |  |  |  | @ISA = ('Math::PlanePath'); | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | use Math::PlanePath::Base::Generic | 
| 36 | 3 |  |  | 3 |  | 18 | 'round_nearest'; | 
|  | 3 |  |  |  |  | 7 |  | 
|  | 3 |  |  |  |  | 252 |  | 
| 37 |  |  |  |  |  |  | *_sqrtint = \&Math::PlanePath::_sqrtint; | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | # uncomment this to run the ### lines | 
| 40 |  |  |  |  |  |  | # use Smart::Comments; | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 3 |  |  | 3 |  | 22 | use constant class_x_negative => 0; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 183 |  | 
| 43 | 3 |  |  | 3 |  | 18 | use constant class_y_negative => 0; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 158 |  | 
| 44 | 3 |  |  | 3 |  | 19 | use constant n_frac_discontinuity => .5; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 348 |  | 
| 45 |  |  |  |  |  |  |  | 
| 46 | 3 |  |  |  |  | 1246 | use constant parameter_info_array => | 
| 47 |  |  |  |  |  |  | [ { name        => 'direction', | 
| 48 |  |  |  |  |  |  | share_key   => 'direction_downup', | 
| 49 |  |  |  |  |  |  | display     => 'Direction', | 
| 50 |  |  |  |  |  |  | type        => 'enum', | 
| 51 |  |  |  |  |  |  | default     => 'down', | 
| 52 |  |  |  |  |  |  | choices     => ['down','up'], | 
| 53 |  |  |  |  |  |  | choices_display => ['Down','Up'], | 
| 54 |  |  |  |  |  |  | description => 'Number points downwards or upwards along the diagonals.', | 
| 55 |  |  |  |  |  |  | }, | 
| 56 |  |  |  |  |  |  | Math::PlanePath::Base::Generic::parameter_info_nstart1(), | 
| 57 |  |  |  |  |  |  | { name        => 'x_start', | 
| 58 |  |  |  |  |  |  | display     => 'X start', | 
| 59 |  |  |  |  |  |  | type        => 'integer', | 
| 60 |  |  |  |  |  |  | default     => 0, | 
| 61 |  |  |  |  |  |  | width       => 3, | 
| 62 |  |  |  |  |  |  | description => 'Starting X coordinate.', | 
| 63 |  |  |  |  |  |  | }, | 
| 64 |  |  |  |  |  |  | { name        => 'y_start', | 
| 65 |  |  |  |  |  |  | display     => 'Y start', | 
| 66 |  |  |  |  |  |  | type        => 'integer', | 
| 67 |  |  |  |  |  |  | default     => 0, | 
| 68 |  |  |  |  |  |  | width       => 3, | 
| 69 |  |  |  |  |  |  | description => 'Starting Y coordinate.', | 
| 70 |  |  |  |  |  |  | }, | 
| 71 | 3 |  |  | 3 |  | 22 | ]; | 
|  | 3 |  |  |  |  | 6 |  | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | sub x_minimum { | 
| 74 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 75 | 0 |  |  |  |  | 0 | return $self->{'x_start'}; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | sub y_minimum { | 
| 78 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 79 | 0 |  |  |  |  | 0 | return $self->{'y_start'}; | 
| 80 |  |  |  |  |  |  | } | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | sub dx_minimum { | 
| 83 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 84 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 85 |  |  |  |  |  |  | ? undef  # down jumps back unlimited at bottom | 
| 86 |  |  |  |  |  |  | : -1);   # up at most -1 across | 
| 87 |  |  |  |  |  |  | } | 
| 88 |  |  |  |  |  |  | sub dx_maximum { | 
| 89 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 90 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 91 |  |  |  |  |  |  | ? 1       # down at most +1 across | 
| 92 |  |  |  |  |  |  | : undef); # up jumps back across unlimited at top | 
| 93 |  |  |  |  |  |  | } | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | sub dy_minimum { | 
| 96 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 97 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 98 |  |  |  |  |  |  | ? -1      # down at most -1 | 
| 99 |  |  |  |  |  |  | : undef); # up jumps down unlimited at top | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  | sub dy_maximum { | 
| 102 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 103 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 104 |  |  |  |  |  |  | ? undef  # down jumps up unlimited at bottom | 
| 105 |  |  |  |  |  |  | : 1);    # up at most +1 | 
| 106 |  |  |  |  |  |  | } | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | sub absdx_minimum { | 
| 109 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 110 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 111 |  |  |  |  |  |  | ? 0   # N=1 dX=0,dY=1 | 
| 112 |  |  |  |  |  |  | : 1); # otherwise always changes | 
| 113 |  |  |  |  |  |  | } | 
| 114 |  |  |  |  |  |  | sub absdy_minimum { | 
| 115 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 116 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 117 |  |  |  |  |  |  | ? 1   # otherwise always changes | 
| 118 |  |  |  |  |  |  | : 0); # N=1 dX=1,dY=0 | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | # within diagonal X+Y=k is dSum=0 | 
| 122 |  |  |  |  |  |  | # end of diagonal X=Xstart+k Y=Ystart | 
| 123 |  |  |  |  |  |  | #             to  X=Xstart   Y=Ystart+k+1 | 
| 124 |  |  |  |  |  |  | # is (Xstart + Ystart+k+1) - (Xstart+k + Ystart) = 1 always, to next diagonal | 
| 125 |  |  |  |  |  |  | # | 
| 126 | 3 |  |  | 3 |  | 24 | use constant dsumxy_minimum => 0; # advancing diagonals | 
|  | 3 |  |  |  |  | 15 |  | 
|  | 3 |  |  |  |  | 178 |  | 
| 127 | 3 |  |  | 3 |  | 24 | use constant dsumxy_maximum => 1; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 2440 |  | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | sub ddiffxy_minimum { | 
| 130 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 131 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 132 |  |  |  |  |  |  | ? undef  # "down" jumps back unlimited at bottom | 
| 133 |  |  |  |  |  |  | : -2);   # NW diagonal | 
| 134 |  |  |  |  |  |  | } | 
| 135 |  |  |  |  |  |  | sub ddiffxy_maximum { | 
| 136 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 137 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 138 |  |  |  |  |  |  | ? 2       # SE diagonal | 
| 139 |  |  |  |  |  |  | : undef); # "up" jumps down unlimited at top | 
| 140 |  |  |  |  |  |  | } | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | sub dir_minimum_dxdy { | 
| 143 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 144 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 145 |  |  |  |  |  |  | ? (0,1)   # North, vertical at N=1 | 
| 146 |  |  |  |  |  |  | : (1,0)); # East,  horiz at N=1 | 
| 147 |  |  |  |  |  |  | } | 
| 148 |  |  |  |  |  |  | sub dir_maximum_dxdy { | 
| 149 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 150 | 0 | 0 |  |  |  | 0 | return ($self->{'direction'} eq 'down' | 
| 151 |  |  |  |  |  |  | ? (1,-1)    # South-East at N=2 | 
| 152 |  |  |  |  |  |  | : (2,-1));  # ESE        at N=3 | 
| 153 |  |  |  |  |  |  | } | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | # If Xstart>0 or Ystart>0 then the origin is not reached. | 
| 156 |  |  |  |  |  |  | sub rsquared_minimum { | 
| 157 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 158 |  |  |  |  |  |  | return ((  $self->{'x_start'} > 0 ? $self->{'x_start'}**2 : 0) | 
| 159 | 0 | 0 |  |  |  | 0 | + ($self->{'y_start'} > 0 ? $self->{'y_start'}**2 : 0)); | 
|  |  | 0 |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | } | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | sub new { | 
| 167 | 6 |  |  | 6 | 1 | 1059 | my $self = shift->SUPER::new(@_); | 
| 168 | 6 | 50 |  |  |  | 39 | if (! defined $self->{'n_start'}) { | 
| 169 | 6 |  |  |  |  | 40 | $self->{'n_start'} = $self->default_n_start; | 
| 170 |  |  |  |  |  |  | } | 
| 171 |  |  |  |  |  |  |  | 
| 172 | 6 |  | 100 |  |  | 32 | my $direction = ($self->{'direction'} ||= 'down'); | 
| 173 | 6 | 50 | 66 |  |  | 33 | if (! ($direction eq 'up' || $direction eq 'down')) { | 
| 174 | 0 |  |  |  |  | 0 | croak "Unrecognised direction option: ", $direction; | 
| 175 |  |  |  |  |  |  | } | 
| 176 |  |  |  |  |  |  |  | 
| 177 | 6 |  | 50 |  |  | 33 | $self->{'x_start'} ||= 0; | 
| 178 | 6 |  | 50 |  |  | 27 | $self->{'y_start'} ||= 0; | 
| 179 | 6 |  |  |  |  | 16 | return $self; | 
| 180 |  |  |  |  |  |  | } | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | # start each diagonal at 0.5 earlier than the integer point | 
| 183 |  |  |  |  |  |  | #   d = [    0,   1,   2,   3,   4 ] | 
| 184 |  |  |  |  |  |  | #   n = [ -0.5, 0.5, 2.5, 5.5, 9.5 ] | 
| 185 |  |  |  |  |  |  | #             +1   +2   +3   +4 | 
| 186 |  |  |  |  |  |  | #                1    1    1 | 
| 187 |  |  |  |  |  |  | # N = (1/2 d^2 + 1/2 d - 1/2) | 
| 188 |  |  |  |  |  |  | #   = (1/2*$d**2 + 1/2*$d - 1/2) | 
| 189 |  |  |  |  |  |  | #   = ((1/2*$d + 1/2)*$d - 1/2) | 
| 190 |  |  |  |  |  |  | # d = -1/2 + sqrt(2 * $n + 5/4) | 
| 191 |  |  |  |  |  |  | #   = (sqrt(8*$n + 5) -1)/2 | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | sub n_to_xy { | 
| 194 | 37 |  |  | 37 | 1 | 30832 | my ($self, $n) = @_; | 
| 195 |  |  |  |  |  |  | ### Diagonals n_to_xy(): "$n   ".(ref $n || '') | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | # adjust to N=0 at origin X=0,Y=0 | 
| 198 | 37 |  |  |  |  | 88 | $n = $n - $self->{'n_start'}; | 
| 199 |  |  |  |  |  |  |  | 
| 200 | 37 |  |  |  |  | 3381 | my $d; | 
| 201 |  |  |  |  |  |  | { | 
| 202 | 37 |  |  |  |  | 56 | my $r = 8*$n + 5; | 
|  | 37 |  |  |  |  | 73 |  | 
| 203 | 37 | 100 |  |  |  | 6106 | if ($r < 1) { | 
| 204 |  |  |  |  |  |  | ### which is N < -0.5 ... | 
| 205 | 2 |  |  |  |  | 368 | return; | 
| 206 |  |  |  |  |  |  | } | 
| 207 |  |  |  |  |  |  | ### sqrt of: "$r" | 
| 208 |  |  |  |  |  |  | ### sqrt is: sqrt(int($r))."" | 
| 209 |  |  |  |  |  |  |  | 
| 210 | 35 |  |  |  |  | 1694 | $d = int((_sqrtint($r) - 1) / 2); | 
| 211 |  |  |  |  |  |  | ### assert: $d >= 0 | 
| 212 |  |  |  |  |  |  | ### d: "$d" | 
| 213 |  |  |  |  |  |  | ### $d | 
| 214 |  |  |  |  |  |  | } | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | # subtract for offset into diagonal, range -0.5 <= $n < $d+0.5 | 
| 217 | 35 |  |  |  |  | 18073 | $n -= $d*($d+1)/2; | 
| 218 |  |  |  |  |  |  | ### subtract to n: "$n" | 
| 219 |  |  |  |  |  |  |  | 
| 220 | 35 |  |  |  |  | 6798 | my $y = -$n + $d;  # $n first so BigFloat not BigInt from $d | 
| 221 |  |  |  |  |  |  | # and X=$n | 
| 222 |  |  |  |  |  |  |  | 
| 223 | 35 | 100 |  |  |  | 1890 | if ($self->{'direction'} eq 'up') { | 
| 224 | 14 |  |  |  |  | 25 | ($n,$y) = ($y,$n); | 
| 225 |  |  |  |  |  |  | } | 
| 226 |  |  |  |  |  |  | return ($n + $self->{'x_start'}, | 
| 227 | 35 |  |  |  |  | 103 | $y + $self->{'y_start'}); | 
| 228 |  |  |  |  |  |  | } | 
| 229 |  |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | # round y on an 0.5 downwards so that x=-0.5,y=0.5 gives n=1 which is the | 
| 231 |  |  |  |  |  |  | # inverse of n_to_xy() ... or is that inconsistent with other classes doing | 
| 232 |  |  |  |  |  |  | # floor() always? | 
| 233 |  |  |  |  |  |  | # | 
| 234 |  |  |  |  |  |  | # d(d+1)/2+1 | 
| 235 |  |  |  |  |  |  | #   = (d^2 + d + 2) / 2 | 
| 236 |  |  |  |  |  |  | # | 
| 237 |  |  |  |  |  |  | sub xy_to_n { | 
| 238 | 34 |  |  | 34 | 1 | 7489 | my ($self, $x, $y) = @_; | 
| 239 |  |  |  |  |  |  | ### xy_to_n(): $x, $y | 
| 240 | 34 |  |  |  |  | 76 | $x = $x - $self->{'x_start'};   # "-" operator to provoke warning if x==undef | 
| 241 | 34 |  |  |  |  | 1070 | $y = $y - $self->{'y_start'}; | 
| 242 | 34 | 100 |  |  |  | 603 | if ($self->{'direction'} eq 'up') { | 
| 243 | 14 |  |  |  |  | 29 | ($x,$y) = ($y,$x); | 
| 244 |  |  |  |  |  |  | } | 
| 245 | 34 |  |  |  |  | 93 | $x = round_nearest ($x); | 
| 246 | 34 |  |  |  |  | 84 | $y = round_nearest (- $y); | 
| 247 |  |  |  |  |  |  | ### rounded | 
| 248 |  |  |  |  |  |  | ### $x | 
| 249 |  |  |  |  |  |  | ### $y | 
| 250 | 34 | 50 | 33 |  |  | 153 | if ($x < 0 || $y > 0) { | 
| 251 | 0 |  |  |  |  | 0 | return undef;  # outside | 
| 252 |  |  |  |  |  |  | } | 
| 253 |  |  |  |  |  |  |  | 
| 254 | 34 |  |  |  |  | 1229 | my $d = $x - $y; | 
| 255 |  |  |  |  |  |  | ### $d | 
| 256 | 34 |  |  |  |  | 1503 | return $d*($d+1)/2 + $x + $self->{'n_start'}; | 
| 257 |  |  |  |  |  |  | } | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | # bottom-left to top-right, used by DiagonalsAlternating too | 
| 260 |  |  |  |  |  |  | # exact | 
| 261 |  |  |  |  |  |  | sub rect_to_n_range { | 
| 262 | 0 |  |  | 0 | 1 |  | my ($self, $x1,$y1, $x2,$y2) = @_; | 
| 263 |  |  |  |  |  |  |  | 
| 264 | 0 | 0 |  |  |  |  | if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } | 
|  | 0 |  |  |  |  |  |  | 
| 265 | 0 | 0 |  |  |  |  | if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } | 
|  | 0 |  |  |  |  |  |  | 
| 266 | 0 | 0 | 0 |  |  |  | if ($x2 < $self->{'x_start'} || $y2 < $self->{'y_start'}) { | 
| 267 | 0 |  |  |  |  |  | return (1, 0); # rect all negative, no N | 
| 268 |  |  |  |  |  |  | } | 
| 269 |  |  |  |  |  |  |  | 
| 270 | 0 |  |  |  |  |  | $x1 = max ($x1, $self->{'x_start'}); | 
| 271 | 0 |  |  |  |  |  | $y1 = max ($y1, $self->{'y_start'}); | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  | # exact range bottom left to top right | 
| 274 | 0 |  |  |  |  |  | return ($self->xy_to_n ($x1,$y1), | 
| 275 |  |  |  |  |  |  | $self->xy_to_n ($x2,$y2)); | 
| 276 |  |  |  |  |  |  | } | 
| 277 |  |  |  |  |  |  |  | 
| 278 |  |  |  |  |  |  | 1; | 
| 279 |  |  |  |  |  |  | __END__ |