File Coverage

blib/lib/Math/PlanePath/QuintetCurve.pm

Criterion	Covered	Total	%
statement	104	126	82.5
branch	37	44	84.0
condition	12	15	80.0
subroutine	12	17	70.5
pod	6	6	100.0
total	171	208	82.2

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


# Boundary of unit squares:
# 2*(4*3^n+1)   cf A199108 = 4*3^n+1
#
# QuintetCurve unit squares boundary
# 12,28,76,220,652
# match 12,28,76,220,652
# [HALF]
# A079003 a(n) = 4*3^(n-2)+2



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

use vars '$VERSION', '@ISA';
$VERSION = 128;

# inherit: new(), rect_to_n_range(), arms_count(), n_start(),
#          parameter_info_array(), xy_is_visited()
use Math::PlanePath::QuintetCentres;
use Math::PlanePath::Base::NSEW;
@ISA = ('Math::PlanePath::Base::NSEW',
        'Math::PlanePath::QuintetCentres');

use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;

use Math::PlanePath::Base::Generic
  'is_infinite',
  'round_nearest';
use Math::PlanePath::Base::Digits
  'digit_split_lowtohigh',
  'round_up_pow';

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


{
  my @x_negative_at_n = (undef, 513, 9, 2, 2);
  sub x_negative_at_n {
    my ($self) = @_;
    return $x_negative_at_n[$self->{'arms'}];
  }
}
{
  my @y_negative_at_n = (undef, 2, 4, 6, 3);
  sub y_negative_at_n {
    my ($self) = @_;
    return $y_negative_at_n[$self->{'arms'}];
  }
}
{
  my @_UNDOCUMENTED__dxdy_list_at_n = (undef, 8, 5, 5, 4);
  sub _UNDOCUMENTED__dxdy_list_at_n {
    my ($self) = @_;
    return $_UNDOCUMENTED__dxdy_list_at_n[$self->{'arms'}];
  }
}

# N=4 first straight, then for other arms 18,27,36
# must override base Math::PlanePath::QuintetCentres
sub _UNDOCUMENTED__turn_any_straight_at_n {
  my ($self) = @_;
  # arms=1   4    only first arm has origin 0
  # arms=2   7
  # arms=3  10
  # arms=4  13
  return 3*$self->arms_count + 1;
}


#------------------------------------------------------------------------------
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
my @digit_reverse = (0,1,0,0,1,0);

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

  if ($n < 0) {
    return;
  }
  if (is_infinite($n)) {
    return ($n,$n);
  }

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

  my $rot = _divrem_mutate ($int,$arms);
  if ($rot) { $int += 1; }

  my @digits = digit_split_lowtohigh($int,5);
  my @sx;
  my @sy;
  {
    my $sy = 0 * $int; # inherit bignum 0
    my $sx = 1 + $sy;  # inherit bignum 1
    foreach (@digits) {
      push @sx, $sx;
      push @sy, $sy;

      # 2*(sx,sy) + rot+90(sx,sy)
      ($sx,$sy) = (2*$sx - $sy,
                   2*$sy + $sx);
    }
    # ### @digits
    # my $rev = 0;
    # for (my $i = $#digits; $i >= 0; $i--) {  # high to low
    #   ### digit: $digits[$i]
    #   if ($rev) {
    #     ### reverse: "$digits[$i] to ".(5 - $digits[$i])
    #     $digits[$i] = (5 - $digits[$i]) % 5;
    #   }
    #   #      $rev ^= $digit_reverse[$digits[$i]];
    #   ### now rev: $rev
  }
  #    ### reversed n: @digits


  my $x = 0;
  my $y = 0;
  my $rev = 0;

  while (defined (my $digit = pop @digits)) {  # high to low
    my $sx = pop @sx;
    my $sy = pop @sy;
    ### at: "$x,$y  digit $digit   side $sx,$sy"

    if ($rot & 2) {
      ($sx,$sy) = (-$sx,-$sy);
    }
    if ($rot & 1) {
      ($sx,$sy) = (-$sy,$sx);
    }

    if ($rev) {
      if ($digit == 0) {
        $rev = 0;
        $rot++;

      } elsif ($digit == 1) {
        $x -= $sy;
        $y += $sx;
        $rot++;

      } elsif ($digit == 2) {
        $x += -2*$sy;
        $y += 2*$sx;

      } elsif ($digit == 3) {
        $x += $sx - 2*$sy;    # add 2*rot-90(side) + side
        $y += $sy + 2*$sx;
        $rot--;
        $rev = 0;

      } else {  # $digit == 4
        $x += $sx - $sy;    # add rot-90(side) + side
        $y += $sy + $sx;
      }

    } else {
      # normal

      if ($digit == 0) {

      } elsif ($digit == 1) {
        $x += $sx;
        $y += $sy;
        $rot--;
        $rev = 1;

      } elsif ($digit == 2) {
        $x += $sx + $sy;    # add side + rot-90(side)
        $y += $sy - $sx;

      } elsif ($digit == 3) {
        $x += 2*$sx + $sy;
        $y += 2*$sy - $sx;
        $rot++;

      } else {  # $digit == 4
        $x += 2*$sx;
        $y += 2*$sy;
        $rot++;
        $rev = 1;
      }
    }

    # lowest non-zero digit determines the direction
    if ($digit != 0) {
      ### frac_dir at non-zero: $rot
    }
  }

  ### final: "$x,$y"
  ### $rot
  $rot &= 3;
  return ($n * $dir4_to_dx[$rot] + $x,
          $n * $dir4_to_dy[$rot] + $y);
}

#                  up  upl left
my @attempt_x = (0, 0, -1, -1);
my @attempt_y = (0, 1,  1, 0);
sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### QuintetCurve xy_to_n(): "$x, $y"

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

  my ($n, $cx, $cy);
  foreach my $i (0, 1, 2, 3) {
    if (defined ($n = $self->SUPER::xy_to_n($x + $attempt_x[$i],
                                            $y + $attempt_y[$i]))
        && (($cx,$cy) = $self->n_to_xy($n))
        && $x == $cx
        && $y == $cy) {
      return $n;
    }
  }
  return undef;
}

#------------------------------------------------------------------------------
# levels

#           arms=1       arms=2            arms=3                 arms=4
# level 0  0..1  = 2    0..2  = 2+1=3     0..3  = 2+1+1=4      0..4 = 2+1+1+1=5
# level 1  0..5  = 6    0..10 = 6+5=11    0..15 = 6+5+5=16     0..20 = 6+5+5+5=21
# level 2  0..25 = 26   0..50 = 26+25=51  0..75 = 26+25+25=76  0..100 = 26+25+25+25=101
#          5^k          2*5^k             3*5^k                 4*5^k
#
sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  5**$level * $self->{'arms'});
}
sub n_to_level {
  my ($self, $n) = @_;
  if ($n < 0) { return undef; }
  if (is_infinite($n)) { return $n; }
  $n = round_nearest($n);
  $n += $self->{'arms'}-1;  # division rounding up
  _divrem_mutate ($n, $self->{'arms'});
  my ($pow, $exp) = round_up_pow ($n, 5);
  return $exp;
}


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

# R,L,L,S
#
# forward       reverse
# 0 forward     0 forward
# 1 reverse     1 reverse
# 2 forward     2 reverse
# 3 forward     3 forward
# 4 reverse     4 reverse
{
  #                                   1   2  3  4
  my @_UNDOCUMENTED__n_to_turn_LSR = (-1, 1, 1, 0,  # forward no low zeros
                                      -1, 1, 0, 0,  # forward low zeros
                                       0,-1,-1, 1,  # reverse
                                       0, 0,-1, 1);
  sub _UNDOCUMENTED__n_to_turn_LSR {
    my ($self, $n) = @_;
    ### _UNDOCUMENTED__n_to_turn_LSR(): $n

    $n += $self->{'arms'}-1;  # division rounding up
    _divrem_mutate ($n, $self->{'arms'});
    if ($n < 1 || is_infinite($n)) { return undef; }

    my $any_low_zeros;
    my $low;
    while ($n) {
      last if ($low = _divrem_mutate($n,5));
      $any_low_zeros = 1;
    }
    ### $low
    ### $any_low_zeros

    my $non_two = 0;
    while (($non_two = _divrem_mutate($n,5)) == 2) {}
    ### $non_two

    $low = $low - 1
      + ($any_low_zeros ? 4 : 0)                   # low zeros
      + ($non_two == 1 || $non_two == 4 ? 8 : 0);  # reverse
    ### lookup: $low
    return $_UNDOCUMENTED__n_to_turn_LSR[$low];
  }
}


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