File Coverage

blib/lib/Math/PlanePath/DiamondSpiral.pm

Criterion	Covered	Total	%
statement	93	100	93.0
branch	25	28	89.2
condition			n/a
subroutine	23	26	88.4
pod	6	6	100.0
total	147	160	91.8

# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 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::DiamondSpiral;
use 5.004;
use strict;

use vars '$VERSION', '@ISA';
$VERSION = 128;
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 xy_is_visited => 1;
use constant parameter_info_array =>
  [ Math::PlanePath::Base::Generic::parameter_info_nstart1() ];

sub x_negative_at_n {
  my ($self) = @_;
  return $self->n_start + 3;
}
sub y_negative_at_n {
  my ($self) = @_;
  return $self->n_start + 4;
}
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  N=1 and other bottom
                                               1,1,   # NE N=6
                                               -1,1,  # NW N=2
                                               -1,-1, # SW N=3
                                               1,-1); # SE N=4
sub _UNDOCUMENTED__dxdy_list_at_n {
  my ($self) = @_;
  return $self->n_start + 5;
}
use constant absdx_minimum => 1;
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

use constant turn_any_right => 0; # only left or straight


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

# start cycle at the vertical downwards from x=1,y=0
# s = [ 0, 1,  2, 3 ]
# n = [ 2, 6, 14,26 ]
# n = 2*$s*$s - 2*$s + 2
# s = .5 + sqrt(.5*$n-.75)
#
# then top of the diamond at 2*$s - 1
# so n - (2*$s*$s - 2*$s + 2 + 2*$s - 1)
#    n - (2*$s*$s + 1)
#
# gives y=$s - n
# then x=$s-abs($y) on the right or x=-$s+abs($y) on the left
#
sub n_to_xy {
  my ($self, $n) = @_;
  #### n_to_xy: $n

  $n = $n - $self->{'n_start'};  # starting $n==0, and warn if $n==undef
  if ($n < 1) {
    if ($n < 0) { return; }
    return ($n, 0);
  }

  my $d = int ( (1 + _sqrtint(2*$n-1)) / 2 );
  #### $d
  #### d frac: ( (1 + _sqrtint(2*$n-1)) / 2 )
  #### base: 2*$d*$d - 2*$d + 2
  #### extra: 2*$d - 1
  #### sub: 2*$d*$d +1

  $n -= 2*$d*$d;
  ### rem from top: $n

  my $y = -abs($n) + $d;  # y=+$d at the top, down to y=-$d
  my $x = abs($y) - $d;  # 0 to $d on the right
  #### uncapped y: $y
  #### abs x: $x

  # cap for horiz at 5 to 6, 13 to 14 etc
  $d = -$d;
  if ($y < $d) { $y = $d; }

  return (($n >= 0 ? $x : -$x),  # negate if on the right
          $y);
}

sub xy_to_n {
  my ($self, $x, $y) = @_;
  $x = round_nearest ($x);
  $y = round_nearest ($y);
  my $d = abs($x) + abs($y);

  # vertical along the y>=0 axis
  # s=0  n=1
  # s=1  n=3
  # s=2  n=9
  # s=3  n=19
  # s=4  n=33
  # n = 2*$d*$d + 1
  #
  my $n = 2*$d*$d;

  # then +/- $d to go to left or right x axis, and -/+ $y from there
  if ($x > 0) {
    ### right quad 1 and 4
    return $n - $d + $y + $self->{'n_start'};
  } else {
    # left quads 2 and 3
    return $n + $d - $y + $self->{'n_start'};
  }
}

#          |                   |  x2>=-x1         |
#    M---+ |               M-------M              |  +---M
#    |   | |               |   |   |              |  |   |
#    +---m |               +----m--+              |  m---+
#          |                   |                  |
#     -----+------      -------+-------      -----+--------
#          |                   |                  |
#
#          |                   |                  |
#    M---+ |               M-------M  y2>=-y1     |  +---M
#    |   | |               |   |   |              |  |   |
#    |   m |               |   |   |              |  m   |
#   -------+------      -------m-------      -----+--------
#    |   | |               |   |   |              |  |   |
#    M---+ |               M-------M              |  +---M
#          |                   |                  |
#
#          |                   |                  |
#     -----+------      -------+-------      -----+--------
#          |                   |                  |
#    +---m |               +--m----+              |  m---+
#    |   | |               |   |   |              |  |   |
#    M---+ |               M-------M              |  +---M
#          |                   |                  |

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

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

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

  my $min_x = ($x2 < 0   ? $x2
               : $x1 > 0 ? $x1
               : 0);
  my $min_y = ($y2 < 0   ? $y2
               : $y1 > 0 ? $y1
               : 0);

  my $max_x = ($x2 > -$x1 ? $x2 : $x1);
  my $max_y = ($y2 >= -$y1+($max_x<=0) ? $y2 : $y1);

  return ($self->xy_to_n($min_x,$min_y),
          $self->xy_to_n($max_x,$max_y));
}

1;
__END__