File Coverage

blib/lib/Math/PlanePath/CornerAlternating.pm

Criterion	Covered	Total	%
statement	94	117	80.3
branch	39	58	67.2
condition	4	8	50.0
subroutine	16	19	84.2
pod	4	4	100.0
total	157	206	76.2

# Copyright 2021 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 .


package Math::PlanePath::CornerAlternating;
use 5.004;
use strict;

use vars '$VERSION', '@ISA';
$VERSION = 129;
use Math::PlanePath;
use Math::PlanePath::Base::NSEW;
*_sqrtint = \&Math::PlanePath::_sqrtint;
@ISA = ('Math::PlanePath::Base::NSEW',
        '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;
*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;

#     |  4---5---6   first South at 6 completing all NSEW
#     |  |       |
#   1 |  3---2       first right turn at 3
#     |      |
# Y=0 |  0---1       first left turn at 1
#     +-----------
sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  return $self->{'n_start'} + $self->{'wider'} + 1;
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  return $self->{'n_start'} + 2*$self->{'wider'} + 3;
}
sub _UNDOCUMENTED__dxdy_list_at_n {
  my ($self) = @_;
  return $self->{'n_start'} + 3*$self->{'wider'} + 6;
}

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

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=0 at origin X=0,Y=0
  $n = $n - $self->{'n_start'};
  if ($n < 0) { return; }

  my $wider = $self->{'wider'};
  my $int = int($n);
  $n -= $int;          # frac part

  # wider==0 n_start=0
  #   row start N=0, 1, 4, 9, 16, 25
  #   N = Y^2
  #   Y = floor sqrt(N)
  #
  # wider==2 n_start=0
  #   N=0, 3, 8, 15, 24
  #   N = Y^2 + 2*Y
  #   Y = floor (-w + sqrt(w^2 + 4*N))/2

  # gnomon number d,
  # starting d=0 for point N=0 at the origin (and more when wider),
  # with point immediately before each gnomon included in the following one
  #
  my $d = int ((_sqrtint(4*($int+1) + $wider*$wider) - $wider) / 2);
  ### d frac: (sqrt(int(4*($int+1)) + $wider*$wider) - $wider) / 2
  ### $d

  # $r ranges -1 upwards, with -1 being the point immediately before gnomon $d
  my $r = $int - $d*($d+$wider);
  ### subtract start: $d*($d+$wider)
  ### $r
  if ($d % 2) {
    if ($r < 0) {
      ### X axis rightward ...
      return ($d+$wider+$n-1, 0);
    } elsif ($r < $d) {
      ### right upward ...
      return ($d+$wider, $r+$n);
    } else {
      ### top leftward ...
      return ($d+$wider-($r-$d)-$n, $d);
    }
  } else {
    if ($r < 0) {
      ### Y axis upward ...
      return (0, $d-1+$n);
    } elsif ($r < $d + $wider) {
      ### top rightward ...
      return ($r+$n, $d);
    } else {
      ### right downward ...
      return ($d+$wider, $d-($r-$d-$wider) - $n);
    }
  }
}

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 ...
    return ($y*($y+$wider)  + ($y % 2 ? 2*$y+$wider - $x : $x)
            + $self->{'n_start'});
  } else {
    ### right vertical ...
    return ($x*$xw          + ($xw % 2 ? $y : $x+$xw - $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 $xmin = $x1;
  my $ymin = $y1;

  my $t = $wider + $y1;     # x where diagonal goes through row y1
  if ($x1 <= $t) {
    ### for min, x1,y1 at or before diagonal ...
    # |   +-------+ / y2
    # |   |       |/          |
    # |   |       /           |                  /
    # |   |      /|           |    +------+     /   y2
    # |   |     / |           |    |      |    /
    # |   @----@--+  y1       |    @------@   /     y1
    # |   x1  /   x2          |   x1     x2  /
    # +------------------     +--------------------
    #  ..wider
    if ($y1 % 2) {
      ### leftward row y1, min at smaller of x2 or diagonal ...
      $xmin = ($x2 < $t ? $x2 : $t);
    }

  } else {
    ### for min, x1,y1 after diagonal ...
    #            /
    # |      +------+  y2     |
    # |      | /    |         |        /
    # |      |/     |         |       /
    # |      @      |         |      / @------+  y2
    # |     /|      |         |     /  |      |
    # |    / @------+  y1     |    /   @------+  y1
    # |   /  x1     x2        |   /   x1     x2
    # +------------------     +------------------
    #    ^...^xw
    #    wider

    $t = $x1 - $wider;
    unless ($t % 2) {
      ### column x1 even, downward ...
      $ymin = ($y2 < $t ? $y2 : $t);
    }
  }

  #-----
  my $xmax = $x2;
  my $ymax = $y2;

  #     |           /
  #     |   @------/  y2     x2,y2 on the diagonal
  #     |   |     /|         executes both "on or before"
  #     |   |    / |         and "on or after"
  #     |   |   /  |         selecting one or other of
  #     |   |  /   |         the opposite points
  #     |   +-/----@  y1     according as direction of
  #     |  x1/     x2        the gnomon
  #     +---------------

  $t = $x2 - $wider;  # y where diagonal passes column x2
  if ($y2 >= $t) {
    ### for max, x2,y2 on or before diagonal ...
    # max is x1 in an odd row (leftward)
    #
    # |              /
    # |    @------@ /y2
    # |    |      |/
    # |    |      /
    # |    |     /|
    # |    |    / |
    # |    +---/--+  y1
    # |   x1  /   x2
    # +----------------
    if ($y2 % 2) {
      ### top row odd, max at leftward x1 ...
      $xmax = $x1;
    }
  }
  if ($y2 <= $t) {
    ### for max, x2,y2 on or after of diagonal ...
    # max is y1 in a downward column ...
    #
    # |         /
    # |     +--/---@  y2
    # |     | /    |
    # |     |/     |
    # |     /      |
    # |    /|      |
    # |   / +------@  y1
    # |  /         x2
    # +-----------------
    #   ^
    #   wider
    #
    unless ($t % 2) {
      ### x2 column even, downward ...
      $ymax = $y1;
    }
  }

  ### min xy: "$xmin,$ymin"
  ### max xy: "$xmax,$ymax"
  return ($self->xy_to_n ($xmin,$ymin),
          $self->xy_to_n ($xmax,$ymax));
}

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

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, nothing special at diagonal
    # +---+-----+----+
    # | 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) + ($d%2 ? 0 : $wider)) {
    $wider++;
    ### increment for +2 after turn on diagonal ...
  }
  return 4*$d + 2*$wider + 2;
}

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