File Coverage

blib/lib/Math/PlanePath/Corner.pm

Criterion	Covered	Total	%
statement	96	111	86.4
branch	24	34	70.5
condition	4	8	50.0
subroutine	20	24	83.3
pod	6	6	100.0
total	150	183	81.9

# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Kevin Ryde

# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath.  If not, see .


# cf Matthew Szudzik ElegantPairing.pdf going inwardly.
#
#   5 | 25--...
#     |
#   4 | 16--17--18--19  24
#     |                  |
#   3 |  9--10--11  15  23
#     |              |   |
#   2 |  4-- 5   8  14  22
#     |          |   |   |
#   1 |  1   4   7  13  21
#     |      |   |   |   |
# Y=0 |  0   2   6  12  20
#     +---------------------
#      X=0   1   2   3   4
#
# cf A185728 where diagonal is last in each gnomon
#    A185725 gnomon sides alternately starting from ends
#    A185726 gnomon sides alternately starting from diagonal
#
# corner going alternately up and down
#    A081344,A194280 by diagonals
#    A081345 X axis, A081346 Y axis
#
# corner alternately up and down, starting with 3-wide
#   A080335  N on diagonal
#   A081347  N on axis
#   A081348  N on axis
#
# cf A004120 ??
#

package Math::PlanePath::Corner;
use 5.004;
use strict;
use List::Util 'min';

use vars '$VERSION', '@ISA';
$VERSION = 127;
use Math::PlanePath;
*_sqrtint = \&Math::PlanePath::_sqrtint;
@ISA = ('Math::PlanePath');

use Math::PlanePath::Base::Generic
  'round_nearest';

# uncomment this to run the ### lines
# use Smart::Comments;


use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant n_frac_discontinuity => .5;
*xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;

use Math::PlanePath::SquareSpiral;
*parameter_info_array = \&Math::PlanePath::SquareSpiral::parameter_info_array;

use constant dx_maximum => 1;
use constant dy_minimum => -1;

# dSum east  dX=1,dY=0  for dSum=+1
#      south dX=0,dY=-1 for dSum=-1
# gnomon up to start of next gnomon is
#    X=wider+k,Y=0 to X=0,Y=k+1
#    dSum = 0-(wider+k) + (k+1)-0
#         = -wider-k + k + 1
#         = 1-wider
sub dsumxy_minimum {
  my ($self) = @_;
  return min(-1, 1-$self->{'wider'});
}
use constant dsumxy_maximum => 1;  # East along top

# dDiffXY east  dX=1,dY=0  for dDiffXY=1-0    = 1
#         south dX=0,dY=-1 for dDiffXY=0-(-1) = 1
# gnomon up to start of next gnomon is
#    X=wider+k,Y=0 to X=0,Y=k+1
#    dDiffXY = 0-(wider+k) - ((k+1)-0)
#            = -wider - 2*k - 1  unbounded negative
use constant ddiffxy_maximum => 1; # East along top

# use constant dir_minimum_dxdy => (1,0); # East  at N=2
use constant dir_maximum_dxdy => (0,-1); # South at N=3

sub turn_any_left {
  my ($self) = @_;
  return ($self->{'wider'} != 0);  # wider=0 no left, right or straight always
}
sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  return ($self->{'wider'} ? $self->n_start + $self->{'wider'}
          : undef);   # wider=0 no left
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  return $self->n_start + $self->{'wider'} + 1;
}


#------------------------------------------------------------------------------

# same as PyramidSides, just 45 degress around

sub new {
  my $self = shift->SUPER::new (@_);
  if (! defined $self->{'n_start'}) {
    $self->{'n_start'} = $self->default_n_start;
  }
  $self->{'wider'} ||= 0;  # default
  return $self;
}

sub n_to_xy {
  my ($self, $n) = @_;
  ### Corner n_to_xy: $n

  # adjust to N=1 at origin X=0,Y=0
  $n = $n - $self->{'n_start'} + 1;

  # comparing $n<0.5, but done in integers for the benefit of Math::BigInt
  if (2*$n < 1) {
    return;
  }

  my $wider = $self->{'wider'};

  # wider==0
  #   vertical at X=0 has N=1, 2, 5, 10, 17, 26
  #   but start 0.5 back so at X=-0.5 have N=0.5, 1.5, 4.5, 9.5, 16.5, 25.5
  #   N = (Y^2 + 1/2)
  #   Y = floor sqrt(N - 1/2)
  #     = floor sqrt(4*N - 2)/2   staying in integers for the sqrt()
  #
  # wider==1
  #   0.5 back so at X=-0.5 have N=0.5, 2.5, 6.5, 12.5
  #   N = (Y^2 + Y + 1/2)
  #   Y = floor -1/2 + sqrt(N - 1/4)
  #     = floor (-1 + sqrt(4*N - 1))/2
  #
  # wider==2
  #   0.5 back so at X=-0.5 have N=0.5, 3.5, 8.5, 15.5
  #   N = (Y^2 + 2 Y + 1/2)
  #   Y = floor -1 + sqrt(N + 1/2)
  #     = floor (-2 + sqrt(4*N + 2))/2
  #
  # wider==3
  #   0.5 back so at X=-0.5 have N=0.5, 4.5, 10.5, 18.5
  #   N = (Y^2 + 3 Y + 1/2)
  #   Y = floor -3/2 + sqrt(N + 7/4)
  #     = floor (-3 + sqrt(4*N + 7))/2
  #
  # 0,1,4,9
  # my $y = int((sqrt(4*$n + -1) - $wider) / 2);
  # ### y frac: (sqrt(4*$n + -1) - $wider) / 2

  my $y = int((_sqrtint(4*$n + $wider*$wider - 2) - $wider) / 2);
  ### y frac: (sqrt(int(4*$n) + $wider*$wider - 2) - $wider) / 2
  ### $y

  # diagonal at X=Y has N=1, 3, 7, 13, 21
  # N = ((Y + 1)*Y + (Y+1)*wider + 1)
  #   = ((Y + 1 + wider)*Y + wider + 1)
  # so subtract that leaving N negative on the horizontal part, or positive
  # for the downward vertical part
  #
  $n -= $y*($y+1+$wider) + $wider + 1;
  ### corner n: $y*($y+1+$wider) + $wider + 1
  ### rem: $n
  ### assert: $n!=$n || $n >= -($y+$wider+0.5)
  # ### assert: $n <= ($y+0.5)

  if ($n < 0) {
    # top horizontal
    return ($n + $y+$wider,
            $y);
  } else {
    # right vertical
    return ($y+$wider,
            -$n + $y);
  }
}

sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### Corner xy_to_n(): "$x,$y"

  $x = round_nearest ($x);
  $y = round_nearest ($y);
  if ($x < 0 || $y < 0) {
    return undef;
  }

  my $wider = $self->{'wider'};
  my $xw = $x - $wider;
  if ($y >= $xw) {
    ### top edge, N left is: $y*$y + $wider*$y + 1
    return ($y*$y + $wider*$y      # Y axis N value
            + $x                   # plus X offset across
            + $self->{'n_start'});
  } else {
    ### right vertical, N diag is: $xw*$xw + $xw*$wider
    ### $xw
    # Ndiag = Nleft + Y+w
    # N = xw*xw + w*xw + 1 + xw+w + (xw - y)
    #   = xw*xw + w*xw + 1 + xw+w + xw - y
    #   = xw*xw + xw*(w+2) + 1 + w - y
    #   = xw*(xw + w+2) + w+1 - y
    return ($xw*($xw+$wider+2) + $wider
            - $y
            +  $self->{'n_start'});
  }
}

# exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  ### Corner rect_to_n_range(): "$x1,$y1, $x2,$y2"

  $x1 = round_nearest ($x1);
  $y1 = round_nearest ($y1);
  $x2 = round_nearest ($x2);
  $y2 = round_nearest ($y2);
  if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }
  if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); }

  if ($y2 < 0 || $x2 < 0) {
    return (1, 0); # rect all negative, no N
  }

  if ($x1 < 0) { $x1 *= 0; }   # "*=" to preserve bigint x1 or y1
  if ($y1 < 0) { $y1 *= 0; }

  my $wider = $self->{'wider'};
  my $ylo = $y1;
  my $xw = $x1 - $wider;

  if ($y1 <= $xw) {
    # left column is partly or wholly below X=Y diagonal
    #
    # make x1,y1 the min pos
    $y1 = ($y2 < $xw

           # wholly below diag, min "*" is at top y2 of the x1 column
           #
           # |        /
           # |       /
           # |      / *------+  y2
           # |     /  |      |
           # |    /   +------+  y1
           # |   /   x1     x2
           # +------------------
           #    ^.....^
           #    wider  xw
           #
           ? $y2

           # only partly below diag, min "*" is the X=Y+wider diagonal at x1
           #
           #            /
           # |      +------+  y2
           # |      | /    |
           # |      |/     |
           # |      *      |
           # |     /|      |
           # |    / +------+  y1
           # |   /  x1     x2
           # +------------------
           #    ^...^xw
           #    wider
           #
           : $xw);
  }

  if ($y2 <= $x2 - $wider) {
    # right column entirely at or below X=Y+wider diagonal so max is at the
    # ylo bottom end of the column
    #
    # |          /
    # |       --/---+  y2
    # |      | /    |
    # |      |/     |
    # |      /      |
    # |     /|      |
    # |    / +------+  ylo
    # |   /         x2
    # +------------------
    #    ^
    #    wider
    #
    $y2 = $ylo;   # x2,y2 now the max pos
  }

  ### min xy: "$x1,$y1"
  ### max xy: "$x2,$y2"
  return ($self->xy_to_n ($x1,$y1),
          $self->xy_to_n ($x2,$y2));
}

#------------------------------------------------------------------------------

sub _NOTDOCUMENTED_n_to_figure_boundary {
  my ($self, $n) = @_;
  ### _NOTDOCUMENTED_n_to_figure_boundary(): $n

  # adjust to N=1 at origin X=0,Y=0
  $n = $n - $self->{'n_start'} + 1;

  if ($n < 1) {
    return undef;
  }

  my $wider = $self->{'wider'};
  if ($n <= $wider) {
    # single block row
    # +---+-----+----+
    # | 1 | ... | $n |  boundary = 2*N + 2
    # +---+-----+----+
    return 2*$n + 2;
  }

  my $d = int((_sqrtint(4*$n + $wider*$wider - 2) - $wider) / 2);
  ### $d
  ### $wider

  if ($n > $d*($d+1+$wider) + $wider) {
    $wider++;
    ### increment for +2 after turn ...
  }
  return 4*$d + 2*$wider + 2;
}

#------------------------------------------------------------------------------
1;
__END__