File Coverage

blib/lib/Math/PlanePath/GreekKeySpiral.pm

Criterion	Covered	Total	%
statement	191	206	92.7
branch	67	80	83.7
condition	8	9	88.8
subroutine	13	19	68.4
pod	7	7	100.0
total	286	321	89.1

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


# math-image --path=GreekKeySpiral --lines --scale=25
# http://gwydir.demon.co.uk/jo/greekkey/corners.htm


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

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

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

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


use constant xy_is_visited => 1;
use constant parameter_info_array =>
  [ { name      => 'turns',
      share_key => 'turns_2',
      display   => 'Turns',
      type      => 'integer',
      minimum   => 0,
      default   => 2,
      width     => 2,
    },
  ];

sub x_negative_at_n {
  my ($self) = @_;
  return $self->n_start + 4*($self->{'turns'}+1)**2;
}
sub y_negative_at_n {
  my ($self) = @_;
  return $self->n_start + 6*($self->{'turns'}+1)**2;
}

#   17--  18--19--20--21
#    |
#   16   3t-2 -- 8 -- 2t
#    |     |          |
#   15   4t-5 ---11   6
#    |            |   |
#   14--  13-----12   5
#                     |
#    1---- 2----- 3-- t
#
sub _UNDOCUMENTED__dxdy_list_at_n {
  my ($self) = @_;
  my $turns = $self->{'turns'};
  return $self->n_start + ($turns == 0   ? 4   # turns=0
                           : $turns <= 2 ? 6   # turns=1,2
                           : 3*$turns - 4);
}

sub turn_any_right {
  my ($self) = @_;
  return ($self->{'turns'} != 0);  # SquareSpiral is left or straight only
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  # turns=1   2,4,7,11,22,29
  return ($self->{'turns'} == 0 ? undef # SquareSpiral left or straight only
          :  $self->n_start + $self->{'midpoint'}-1);
}
sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  my $turns = $self->{'turns'};
  # turns=1   2,4,7,11,22,29
  return $self->n_start + ($turns==0 ? 1
                           : $turns==1 ? 3
                           : $turns-1);
}


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

# turns=1
#       2---3
#       |   |
#   0---1   4
#
# turns=2                   |
#       5---6---7          18  15--14
#       |       |           |   |   |
#       4---3   8          17--16  13         x=1,y=1
#           |   |                   |
#   0---1---2   9          10--11--12
#
# turns=3
#     10--11--12--13
#      |           |
#      9   6---5  14                             x=2,y=1
#      |   |   |   |
#      8---7   4  15
#              |   |
#  0---1---2---3  16
#
# turns=4
#     17--18--19--20--21  50  37--36--35--34
#      |               |   |   |           |    3,3,2,1,1,1,2,3,4,down4
#     16   9---8---7  22  49  38  41--42  33
#      |   |       |   |   |   |   |   |   |
#     15  10--11   6  23  48  39--40  43  32      x=3,y=2
#      |       |   |   |   |           |   |
#     14--13--12   5  24  47--46--45--44  31
#                  |   |                   |
#  0---1---2---3---4  25--26--27--28--29--30    5,4,3,2,1,1,1,2,3,up3
#
# turns=5
#      26--27--28--29--30--31
#       |                   |       4,4,3,2,1,1,1,2,3,4,5,5
#      25  12--11--10---9  32
#       |   |           |   |
#      24  13  16--17   8  33       5,4,3,2,1,1,1,2,3,4,5,rem
#   |   |   |   |   |   |   |
#  35  23  14--15  18   7  34
#   |   |           |   |   |                     x=3,y=3
#  36  22--21--20--19   6  35
#                       |   |
#   0---1---2---3---4---5  36-
#
# turns=6
#      37--38--39--40--41--42--43
#       |                       |
#      36  15--14--13--12--11  44                x=3,y=3
#       |   |               |   |
#      35  16  23--24--25  10  45
#       |   |   |       |   |   |
#      34  17  22--21  26   9  46   6,5,4,3,2,1,1,1,2,3,4,5,rem
#       |   |       |   |   |   |
#      33  18--19--20  27   8  47
#       |               |   |   |
#      32--31--30--29--28   7  48
#                           |   |
#   0---1---2---3---4---5---6  49-
#
# turns=7
#      50--51--52--53--54--55--56--57
#       |                           |
#      49  18--17--16--15--14--13  58
#       |   |                   |   |
#      48  19  32--33--34--35  12  59               x=4,y=3
#       |   |   |           |   |   |
#      47  20  31  28--27  36  11  60
#       |   |   |   |   |   |   |   |
#      46  21  30--29  26  37  10  61  6,5,4,3,2,1,1,1,2,3,4,5,rem
#       |   |           |   |   |   |
#      45  22--23--24--25  38   9  62
#       |                   |   |   |
#      44--43--42--41--40--39   8  63
#                               |   |
#   0---1---2---3---4---5---6---7  64
#
# turns=8   x=5,y=4


# centre
# 2   1 1
# 3   2 1

# 4   3 2
# 5   3 3
# 6   3 3
# 7   4 3

# 8   5 4
# 9   5 5
# 10  5 5
# 11  6 5

# 12  7 6
# 13  7 7
# 14  7 7
# 15  8 7
#
# turns 2, 3,  4,  5
# midp  4  6, 10, 15, 21   N = (1/2 d^2 + 1/2 d)
#
# 63, 189, 387, 657
# 9*7 9*21, 9*43, 9*73
#
# 82     226     442
# 9*9+1  9*25+1  9*49+1

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

  my $turns = $self->{'turns'};
  if (! defined $turns) {
    $turns = 2;
  } elsif ($turns < 0) {
  }
  $self->{'turns'} = $turns;
  my $t1 = $turns + 1;

  if (! defined $self->{'n_start'}) {
    $self->{'n_start'} = $self->default_n_start;
  }

  $self->{'centre_x'} = int($t1/2) + (($turns%4)==0);
  $self->{'centre_y'} = int($turns/2) + (($turns%4)==1);

  $self->{'midpoint'} = $turns*$t1/2 + 1;
  $self->{'side'} = $t1;
  $self->{'squared'} = $t1*$t1;

  ### turns   : $self->{'turns'}
  ### midpoint: $self->{'midpoint'}
  ### side    : $self->{'side'}
  ### squared : $self->{'squared'}

  return $self;
}

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

  $n = $n - $self->{'n_start'};
  ### n zero based: $n
  if ($n < 0) { return; }

  my $turns = $self->{'turns'};
  my $squared = $self->{'squared'};
  my $side = $turns + 1;

  ### sqrt of: ($n-1) / $squared

  my $d = _sqrtint($n / $squared);
  $n -= $squared*$d*$d - 1;
  my $dhalf = int($d/2);

  ### $d
  ### $dhalf
  ### n remainder: $n

  my ($x,$y);
  my $square_rot = 0;
  my $frac;
  { my $int = int($n);
    $frac = $n - int($n);
    $n = $int;
  }
  ### $frac
  ### $n

  if ($d % 2) {
    ### odd d, right and top ...
    if ($n >= $squared*($d+1)) {
      ### top ...
      $n -= $squared*2*$d;
      (my $q, $n) = _divrem ($n, $squared);
      $x = (-$dhalf-$q)*$side + 1;
      $y = ($dhalf+1)*$side;
      $square_rot = 2;
    } else {
      ### right ...
      (my $q, $n) = _divrem ($n-$turns-1 + $squared, $squared);
      $x = ($dhalf+1)*$side;
      $y = ($q-$dhalf-1)*$side;
      $square_rot = 1;
    }
  } else {
    ### even d, left and bottom ...
    if ($d == 0 || $n >= $squared*($d+1)) {
      ### bottom ...
      $n -= $squared*2*$d;
      (my $q, $n) = _divrem ($n, $squared);
      $x = ($dhalf+$q)*$side-1;
      $y = -($dhalf)*$side;
      $square_rot = 0;
    } else {
      ### left ...
      (my $q, $n) = _divrem ($n-$turns-1 + $squared, $squared);
      $x = -($dhalf)*$side;
      $y = -($q-$dhalf-1)*$side;
      $square_rot = 3;
    }
  }

  ### assert: ! ($n < 0)
  ### assert: ! ($n >= $squared)

  my $rot = $turns;
  my $kx = 0;
  my $ky = 0;
  my $before;
  ### n-midpoint: $n - $self->{'midpoint'}

  if (($n -= $self->{'midpoint'}) >= 0) {
    ### after middle ...
  } elsif ($n += 1) {
    ### before middle ...
    $n = -$n;
    if ($frac) {
      ### fraction ...
      $frac = 1-$frac;
      $n -= 1;
    } else {
      ### integer ...
      $n -= 0;
    }
    $rot += 2;
    $before = 1;
  } else {
    ### centre segment ...
    $rot += 1;
    $before = 1;
  }
  ### key n: $n

  # d: [ 0, 1,  2 ]
  # n: [ 0, 3, 10 ]
  # d = -1/4 + sqrt(1/2 * $n + 1/16)
  #   = (-1 + sqrt(8*$n + 1)) / 4
  # N = (2*$d + 1)*$d
  # rel = (2*$d + 1)*$d + 2*$d+1
  #     = (2*$d + 3)*$d + 1
  #
  $d = int( (_sqrtint(8*$n+1) - 1)/4 );
  $n -= (2*$d+3)*$d + 1;
  ### $d
  ### key signed rem: $n

  if ($n < 0) {
    ### key vertical ...
    $kx += $d;
    $ky = -$frac-$n-$d - 1 + $ky;
    if ($d % 2) {
      ### key right ...
      $rot += 2;
      $kx += 1;
    } else {
    }
  } else {
    ### key horizontal ...
    $kx = $frac+$n-$d + $kx;
    $ky += $d + 1;
    $rot += 2;
    if ($d % 2) {
      ### key bottom ...
      $rot += 2;
      $kx += -1;
    } else {
    }
  }
  ### kxy raw: "$kx, $ky"

  if ($rot & 2) {
    $kx = -$kx;
    $ky = -$ky;
  }
  if ($rot & 1) {
    ($kx,$ky) = (-$ky,$kx);
  }
  ### kxy rotated: "$kx,$ky"

  if ($before) {
    if (($turns % 4) == 0) {
      $kx -= 1;
    }
    if (($turns % 4) == 1) {
      $ky -= 1;
    }
    if (($turns % 4) == 2) {
      $kx += 1;
    }
    if (($turns % 4) == 3) {
      $ky += 1;
    }
  }

  $kx += $self->{'centre_x'};
  $ky += $self->{'centre_y'};

  if ($square_rot & 2) {
    $kx = $turns-$kx;
    $ky = $turns-$ky;
  }
  if ($square_rot & 1) {
    ($kx,$ky) = ($turns-$ky,$kx);
  }

  # kx,ky first to inherit BigRat etc from $frac
  return ($kx + $x,
          $ky + $y);
}


# t+(t-1)+(t-2)+(t-3) = 4t-6

# y=0  0
# y=2  0+1+2+3  total 6
# y=4  4+5+6+7  total 28
#      (2 d^2 - d)
# N=4*t*y/2 - (2y-1)*y
#  =(2t - 2y + 1)*y

# x=1  0+1+2    total 3
# x=3  3+4+5+6  total 21
# x=5  7+8+9+10 total 55
#      (2 d^2 + d)
# N = 4*t*(x-1)/2 + 3t-3 - (2x+1)*x
#   = 2*t*(x-1) + 3t-3 - (2x+1)*x
#   = 2tx-2t + 3t-3 - (2x+1)*x
#   = (2t-2x-1)x - 2t + 3t-3
#   = (2t-2x-1)x + t-3

# y=0  squared-t-t                total 0
# y=2  - (t-1)-(t-2)-(t-3)-(t-4)  total 10
# y=4  - 5+6+7+8                  total 36
#      (2 d^2 + d)
# N = squared - 4*t*y/2 - 2t - (2y+1)*y +(x-y)
#   = squared - (2t+2y+1)*y - 2t + x

sub xy_to_n {
  my ($self, $x, $y) = @_;

  $x = round_nearest ($x);
  $y = round_nearest ($y);
  ### xy_to_n: "x=$x, y=$y"

  my $turns = $self->{'turns'};
  my $side = $turns + 1;
  my $squared = $self->{'squared'};

  my $xs = floor($x/$side);
  my $ys = floor($y/$side);
  $x %= $side;
  $y %= $side;
  my $n;
  if ($xs > -$ys) {
    ### top or right
    if ($xs >= $ys) {
      ### right going upwards
      $n = $squared*((4*$xs - 3)*$xs + $ys);
      ($x,$y) = ($y,$turns-$x);  # rotate -90
      if ($x == 0) {
        $x = $turns;
        $n -= $side*$turns;   # +$side modulo
      } else {
        $x -= 1;
        $n += $side;
      }
    } else {
      ### top going leftwards
      $n = $squared*((4*$ys - 1)*$ys - $xs);
      $x = $turns-$x;  # rotate 180
      $y = $turns-$y;
    }
  } else {
    ### bottom or left
    if ($xs > $ys || ($xs == 0 && $ys == 0)) {
      ### bottom going rightwards: "$xs,$ys"
      $n = $squared*((4*$ys - 3)*$ys + $xs);
    } else {
      ### left going downwards
      $n = $squared*((4*$xs - 1)*$xs - $ys);
      ($x,$y) = ($turns-$y,$x);  # rotate +90
      if ($x == 0) {
        $x = $turns;
        $n -= $side*$turns;   # +$side modulo
      } else {
        $x -= 1;
        $n += $side;
      }
    }
  }

  if ($x + $y >= $turns) {
    ### key top or right ...
    if ($x > $y) {
      ### key right ...
      $x = $turns-$x;
      if ($x % 2) {
        ### forward ...
        $n += (2*$turns-2*$x+2)*$x + $y - $turns;
      } else {
        ### backward ...
        $n += $squared - (2*$turns-2*$x+2)*$x - $y;
      }
    } else {
      ### key top ...
      $y = $turns-$y;
      if ($y % 2) {
        ### backward ...
        $n += (2*$turns-2*$y)*$y + $turns-$x;
      } else {
        ### forward ...
        $n += $squared - (2*$turns - 2*$y)*$y - 2*$turns + $x;
      }
    }
  } else {
    ### key bottom or left ...
    if ($x >= $y) {
      ### key bottom ...
      if ($y % 2) {
        ### backward ...
        $n += $squared - (2*$turns - 2*$y)*$y - $turns - $x - 1;
      } else {
        ### forward ...
        $n += (2*$turns-2*$y)*$y + $x + 1;
      }
    } else {
      ### key left ...
      if ($x % 2) {
        ### forward ...
        $n += (2*$turns-2*$x-2)*$x + 2*$turns - $y;
      } else {
        ### backward ...
        $n += $squared - (2*$turns - 2*$x - 2)*$x - 3*$turns + $y;
      }
    }
  }

  return $n + $self->{'n_start'}-1;
}

use Math::PlanePath::SquareArms;
*_rect_square_range = \&Math::PlanePath::SquareArms::_rect_square_range;

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

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

  # floor divisions to square blocks
  {
    my $side = $self->{'turns'} + 1;
    _divrem_mutate($x1,$side);
    _divrem_mutate($y1,$side);
    _divrem_mutate($x2,$side);
    _divrem_mutate($y2,$side);
  }
  my ($dlo, $dhi) = _rect_square_range ($x1, $y1,
                                        $x2, $y2);
  my $squared = $self->{'squared'};

  ### d range sides: "$dlo, $dhi"
  ### right start: ((4*$squared*$dlo - 4*$squared)*$dlo + 10)

  return (($dlo == 0 ? 0  # special case Nlo=1 for innermost square
          # Nlo at right vertical start
          : ((4*$squared*$dlo - 4*$squared)*$dlo + $squared))
          + $self->{'n_start'},

          # Nhi at bottom horizontal end
          (4*$squared*$dhi + 4*$squared)*$dhi
          + $squared
          + $self->{'n_start'}-1);
}

1;
__END__