File Coverage

blib/lib/Math/PlanePath/AnvilSpiral.pm

Criterion	Covered	Total	%
statement	122	133	91.7
branch	33	36	91.6
condition	2	4	50.0
subroutine	22	27	81.4
pod	6	6	100.0
total	185	206	89.8

# Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 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 .


# math-image --path=AnvilSpiral --all --output=numbers_dash
# math-image --path=AnvilSpiral,wider=3 --all --output=numbers_dash

package Math::PlanePath::AnvilSpiral;
use 5.004;
use strict;
#use List::Util 'min','max';
*min = \&Math::PlanePath::_min;
*max = \&Math::PlanePath::_max;

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

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


# pentagonal N = (3k-1)*k/2
# preceding
# Np = (3k-1)*k/2 - 1
#    = (3k^2 - k - 2)/2
#    = (3k+2)(k-1)/2
#


# parameters "wider","n_start"
use Math::PlanePath::SquareSpiral;
*parameter_info_array
  = \&Math::PlanePath::SquareSpiral::parameter_info_array;
use constant xy_is_visited => 1;

use constant dx_minimum => -1;
use constant dx_maximum => 1;
use constant dy_minimum => -1;
use constant dy_maximum => 1;
use constant 1.02 _UNDOCUMENTED__dxdy_list => (1,0,   # E       # no N,S
                                               1,1,   # NE
                                               -1,1,  # NW
                                               -1,0,  # W
                                               -1,-1, # SW
                                               1,-1); # SE
# last NW at lower right
#     2w+4 ------- w+1
#       \          /
#        *  0---- w  *
#       /             \
#     2w+6 ---------- 3w+10    w=3; 1+3*w+10=20
#
sub x_negative_at_n {
  my ($self) = @_;
  return $self->n_start + ($self->{'wider'} ? 0 : 3);
}
sub y_negative_at_n {
  my ($self) = @_;
  return $self->n_start + 2*$self->{'wider'} + 6;
}
sub _UNDOCUMENTED__dxdy_list_at_n {
  my ($self) = @_;
  return $self->n_start + 3*$self->{'wider'} + 10;
}

use constant absdx_minimum => 1;  # abs(dX)=1 always
use constant dsumxy_minimum => -2; # diagonals
use constant dsumxy_maximum => 2;
use constant ddiffxy_minimum => -2;
use constant ddiffxy_maximum => 2;
use constant dir_maximum_dxdy => (1,-1); # South-East

sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  # left turn at w when w!=0 or at w+1 when w==0
  return $self->n_start + ($self->{'wider'} || 1);
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  return $self->n_start + 2*$self->{'wider'} + 5;
}


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

sub new {
  my $self = shift->SUPER::new (@_);

  # parameters
  if (! defined $self->{'n_start'}) {
    $self->{'n_start'} = $self->default_n_start;
  }
  $self->{'wider'} ||= 0;  # default

  return $self;
}

# [1,2,3,4],[1,12,35,70]   # horizontal
# N = (6 d^2 - 7 d + 2)
#   = (6*$d**2 - 7*$d + 2)
#   = ((6*$d - 7)*$d + 2)
# d = 7/12 + sqrt(1/6 * $n + 1/144)
#   = (7 + 12*sqrt(1/6 * $n + 1/144))/12
#   = (7 + sqrt(144/6*$n + 1))/12
#   = (7 + sqrt(24*$n + 1))/12
#
# wider=1
# [1,2,3,4],[1+1,12+1+2,35+1+2+2,70+1+2+2+2]
# N = (6 d^2 - 5 d + 1)
# d = 5/12 + sqrt(1/6 * $n + 1/144)
#
# wider=2
# [1,2,3,4],[1+2,12+2+4,35+2+4+4,70+2+4+4+4]
# N = (6 d^2 - 3 d)
# d = 3/12 + sqrt(1/6 * $n + 9/144)
#
# wider=3
# [1,2,3,4],[1+3,12+3+6,35+3+6+6,70+3+6+6+6]
# N = (6 d^2 - d - 1)
# d = 1/12 + sqrt(1/6 * $n + 25/144)
#
# wider=4
# [1,2,3,4],[1+4,12+4+8,35+4+8+8,70+4+8+8+8]
# N = (6 d^2 + d - 2)
# d = -1/12 + sqrt(1/6 * $n + 49/144)         # 49=7*7=(2w-1)*(2w-1)
#
# in general
# N = (6 d^2 - (7-2w) d + 2-w)
#   = (6d - (7-2w)) d + 2-w
#   = (6d - 7 + 2w))*d + 2-w
# d = (7-2w)/12 + sqrt(1/6 * $n + (w-1)^2/144)
#   = [ 7-2w + 12*sqrt(1/6 * $n + (w-1)^2/144) ] / 12
#   = [ 7-2w + sqrt(144/6*$n + (w-1)^2) ] / 12
#   = [ 7-2w + sqrt(24*$n + (w-1)^2) ] / 12



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

  $n = $n - $self->{'n_start'};  # to N=0 basis, warning if $n==undef
  if ($n < 0) { return; }
  my $w = $self->{'wider'};
  my $w_right = int($w/2);
  my $w_left = $w - $w_right;
  ### $w
  ### $w_left
  ### $w_right

  if ($n <= $w) {
    ### centre horizontal
    return ($n - $w_left,  # N=0 at $w_left
            0);
  }

  my $d = int((_sqrtint(24*($n+1) + (2*$w-1)**2) + 7-2*$w) / 12);
  ### ($n+1)
  ### $d
  ### d frac: ((sqrt(int(24*($n+1)) + (2*$w-1)**2) + 7-2*$w) / 12)
  ### d sqrt add: ($w-1)*($w-1)
  ### d const part: 7-2*$w

  $n -= (6*$d - 7 + 2*$w)*$d + 2-$w;
  ### base: (6*$d - 7 + 2*$w)*$d + 2-$w
  ### remainder: $n

  if ($n <= 5*$d+$w-2) {
    if ($n+1 <= $d) {
      ### upper right slope ...
      return ($n + $d + $w_right,
              $n+1);
    } else {
      ### top ...
      return (-$n + 3*$d + $w_right - 2,
              $d);
    }
  }

  $n -= 7*$d + $w - 2;
  if ($n <= 0) {
    ### left slopes: $n
    return (-abs($n+$d) - $d - $w_left,
            -$n - $d);
  }

  $n -= 4*$d + $w;
  if ($n < 0) {
    ### bottom ...
    return ($n + 2*$d + $w_right,
            -$d);
  } else {
    ### right lower ...
    return (-$n + 2*$d + $w_right,
            $n - $d);
  }
}

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

  $x = round_nearest ($x);
  $y = round_nearest ($y);

  my $w = $self->{'wider'};
  my $w_right = int($w/2);
  my $w_left = $w - $w_right;
  ### $w
  ### $w_left
  ### $w_right

  my $abs_y = abs($y);
  if ($x-$w_right >= 2*$abs_y) {
    ### right slopes: "d=".($x-$w_right - $abs_y)
    my $d = $x-$w_right - $abs_y;  # zero based
    return ((6*$d + 5 + 2*$w)*$d + $w
            + $y
            + $self->{'n_start'});
  }

  if ($x+$w_left < -2*$abs_y) {
    ### left slopes: "d=".($x+$w_left + $abs_y)
    my $d = $x+$w_left + $abs_y;  # negative, and zero based
    return ((6*$d + 1 - 2*$w)*$d
            - $y
            + $self->{'n_start'});
  }

  if ($y > 0) {
    ### top horizontal ...
    return ((6*$y - 4 + 2*$w)*$y - $w
            + $w_right-$x
            + $self->{'n_start'});
  } else {
    ### bottom horizontal ...
    # y negative
    return ((6*$y - 2 - 2*$w)*$y
            + $x+$w_left
            + $self->{'n_start'});
  }
}

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

#      ...-78-77-76-75-74
#                     /
# 43-42-41-40-39-38 73
#               /  /
# 17-16-15-14 37 72
#         /  /  /
# -3--2 13 36 71
#   /  /  /  /
#  1 12 35 70
#
# column X=2, dmin decreasing until Y=1=floor(x/2)
# column X=3, dmin decreasing until Y=2=ceil(x/2)
# so x1 - min(y2,int((x1+1)/2))
#
#
# column Xmax=2, dmax increasing down until x2-y1
#
# horizontal Y>=0 N increases left and right of X=Y*3/2
#    so candidate max at top-left x1,y2 or top-right x2,y2
#
# horizontal Y<0 N increases left and right of X=-Y*3/2
#    so candidate max at bottom-left x1,y1 or bottom-right x2,y1
#
# vertical Y>=0 N increases above and below Y=ceil(X/2)
#    so candidate max at top-right or bottom-right, or Y=0
#
# vertical Y<0 N increases above and below Y=ceil(X/2)
#    so candidate max at top-right or bottom-right, or Y=0
#
  # int(($y2+1)/2), $y2
  # int(($y1+1)/2), $y1
  #
  # my @corners = ($self->xy_to_n($x1,$y1),
  #                $self->xy_to_n($x2,$y1),
  #                $self->xy_to_n($x1,$y2),
  #                $self->xy_to_n($x2,$y2));
  # return (($x_zero && $y_zero ? 1 : min (@corners)),
  #         max (@corners,
  #               ($y_zero ? ($self->xy_to_n($x1,0),
  #                           $self->xy_to_n($x2,0)) : ())));




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

  my $w = $self->{'wider'};
  my $w_right = int($w/2);
  my $w_left = $w - $w_right;

  $x1 = round_nearest($x1);
  $x2 = round_nearest($x2);
  $y1 = round_nearest($y1);
  $y2 = round_nearest($y2);

  my $x_zero = (($x1<0) != ($x2<0));
  my $y_zero = (($y1<0) != ($y2<0));
  ### $x_zero
  ### $y_zero

  $x1 += $w_left;
  $x2 += $w_left;

  if ($x1 < 0) { $x1 = $w-$x1; }
  if ($x2 < 0) { $x2 = $w-$x2; }
  $y1 = abs($y1);
  $y2 = abs($y2);

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

  if ($x_zero) { $x1 = 0; }
  if ($y_zero) { $y1 = 0; }

  ### abs: "$x1,$y1  $x2,$y2"
  ### d1 slope max y: int(($x1+1)/2)
  ### d1 slope: $x1 - min($y2,int(($x1+1)/2))

  #   --------*
  #          /
  #         /
  #        *   <-y=0
  # x=0....w
  #
  # d=x-w-y on the slope
  # d=y     on the top horizontal
  #
  my $d1 = min ($x1-$w - min($y2,int(($x1-$w+1)/2)) - 1,
                $y2);
  my $d2 = 1 + max ($x2-$w - $y1,
                    $y2);
  ### $d1
  ### $d2
  ### d2 right slope would be: $x2-$w_right - $y2

  # d1==0 is the centre horizontal
  #

  return ($d1 <= 0
          ? $self->{'n_start'}
          : (6*$d1 - 7 + 2*$w)*$d1 + 1-$w + $self->{'n_start'},

          (6*$d2 - 6 + 2*$w)*$d2 - $w + $self->{'n_start'});
}

1;
__END__