File Coverage

blib/lib/Math/PlanePath/SquareArms.pm

Criterion	Covered	Total	%
statement	46	90	51.1
branch	6	24	25.0
condition	2	6	33.3
subroutine	12	15	80.0
pod	3	3	100.0
total	69	138	50.0

# 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=SquareArms --lines --scale=10
# math-image --path=SquareArms --all --output=numbers_dash
# math-image --path=SquareArms --values=Polygonal,polygonal=8
#
# RepdigitsAnyBase fall on 14 or 15 lines ...
#

package Math::PlanePath::SquareArms;
use 5.004;
use strict;
#use List::Util 'max';
*max = \&Math::PlanePath::_max;

use vars '$VERSION', '@ISA';
$VERSION = 128;
use Math::PlanePath;
use Math::PlanePath::Base::NSEW;
@ISA = ('Math::PlanePath::Base::NSEW',
        'Math::PlanePath');

use Math::PlanePath::Base::Generic
  'round_nearest';
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
*_sqrtint = \&Math::PlanePath::_sqrtint;

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


use constant arms_count => 4;
use constant xy_is_visited => 1;
use constant x_negative_at_n => 4;
use constant y_negative_at_n => 5;
use constant turn_any_right => 0; # only left or straight


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

# 28
# 172 +144
# 444 +272 +128
# 844 +400 +128

# [ 0, 1, 2, 3,],
# [ 0, 2, 6, 12 ],
# N = (d^2 + d)
# d = -1/2 + sqrt(1 * $n + 1/4)
#   = (-1 + 2*sqrt($n + 1/4)) / 2
#   = (-1 + sqrt(4*$n + 1)) / 2

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

  if ($n < 2) {
    if ($n < 1) { return; }
    ### centre
    return (0, 1-$n);  # from n=1 towards n=5 at x=0,y=-1
  }
  $n -= 2;

  my $frac;
  { my $int = int($n);
    $frac = $n - $int;
    $n = $int;  # BigFloat int() gives BigInt, use that
  }

  # arm as initial rotation
  my $rot = _divrem_mutate($n,4);
  ### $n

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

  $n -= $d*($d+1);
  ### remainder: $n

  $rot += ($d % 4);
  my $x = $d + 1;
  my $y = $frac + $n - $d;

  $rot %= 4;
  if ($rot & 2) {
    $x = -$x;  # rotate 180
    $y = -$y;
  }
  if ($rot & 1) {
    return (-$y,$x);  # rotate +90
  } else {
    return ($x,$y);
  }
}

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

  if ($x == 0 && $y == 0) {
    return 1;
  }

  my $rot = 0;
  # eg. y=2 have (0<=>$y)-$y == -1-2 == -3
  if ($y <= ($x <=> 0) - $x) {
    ### below diagonal, rot 180 ...
    $rot = 2;
    $x = -$x;  # rotate 180
    $y = -$y;
  }
  if ($x < $y) {
    ### left of diagonal, rot -90 ...
    $rot++;
    ($x,$y) = ($y,-$x);       # rotate -90
  }

  # diagonal down from N=2
  #     x=1  d=0   n=2
  #     x=5  d=4   n=82
  #     x=9  d=8   n=290
  #     x=13 d=12  n=626
  # N = (4 d^2 + 4 d + 2)
  #   = (4 x^2 - 4 x + 2)
  # offset = y + x-1    upwards from diagonal
  # N + 4*offset
  #   = (4*x^2 - 4*x + 2) + 4*(y + x-1)
  #   = 4*x^2 - 4*x + 2 + 4*y + 4*x - 4
  #   = 4*x^2 + 4*y - 2
  # cf N=4*x^2 is on the X or Y axis, which is X axis after rotation
  #
  ### xy: "$x,$y"
  ### $rot
  ### x offset: $x-1 + $y
  ### d mod: $d % 4
  ### rot d mod: (($rot-$d) % 4)
  return ($x*$x + $y)*4 - 2 + (($rot-$x+1) % 4);
}

# d    = [ 1, 2,   3,  4,  5,   6,   7,   8,   9 ],
# Nmax = [ 9, 25, 49, 81, 121, 169, 225, 289, 361 ]
#   being the N=5 arm one spot before the corner of each run
# N = (4 d^2 + 4 d + 1)
#   = (2d+1)^2
#   = ((4*$d + 4)*$d + 1)
# or for d-1
# N = (4 d^2 - 4 d + 1)
#   = (2d-1)^2
#   = ((4*$d - 4)*$d + 1)
#
# not exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  my ($d_lo, $d_hi) = _rect_square_range ($x1,$y1, $x2,$y2);
  return (((4*$d_lo - 4)*$d_lo + 1),
          max ($self->xy_to_n($x1,$y1),
                $self->xy_to_n($x1,$y2),
                $self->xy_to_n($x2,$y1),
                $self->xy_to_n($x2,$y2)));
}

sub _rect_square_range {
  my ($x1,$y1, $x2,$y2) = @_;
  ### _rect_square_range(): "$x1,$y1  $x2,$y2"

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

  # if x1,x2 opposite signs then origin x=0 covered, similarly y
  my $x_zero_uncovered = ($x1<0) == ($x2<0);
  my $y_zero_uncovered = ($y1<0) == ($y2<0);

  foreach ($x1,$y1, $x2,$y2) {
    $_ = abs($_);
  }
  ### abs rect: "x=$x1 to $x2,  y=$y1 to $y2"

  if ($x2 < $x1) { ($x1,$x2) = ($x2,$x1) } # swap to x1
  if ($y2 < $y1) { ($y1,$y2) = ($y2,$y1) } # swap to y1

  my $dlo = ($x_zero_uncovered ? $x1 : 0);
  if ($y_zero_uncovered && $dlo < $y1) { $dlo = $y1 }

  return ($dlo,
          ($x2 > $y2 ? $x2 : $y2));
}

1;
__END__