File Coverage

blib/lib/Math/PlanePath/AlternateTerdragon.pm

Criterion	Covered	Total	%
statement	176	214	82.2
branch	48	72	66.6
condition	24	26	92.3
subroutine	28	39	71.7
pod	16	16	100.0
total	292	367	79.5

# Copyright 2018 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::AlternateTerdragon;
use 5.004;
use strict;
use List::Util 'first';
use List::Util 'min'; # 'max'
*max = \&Math::PlanePath::_max;

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

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

use vars '$VERSION', '@ISA';
$VERSION = 127;
@ISA = ('Math::PlanePath');

use Math::PlanePath::TerdragonMidpoint;

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


use constant n_start => 0;
use constant parameter_info_array =>
  [ { name      => 'arms',
      share_key => 'arms_6',
      display   => 'Arms',
      type      => 'integer',
      minimum   => 1,
      maximum   => 6,
      default   => 1,
      width     => 1,
      description => 'Arms',
    } ];

sub x_negative {
  my ($self) = @_;
  return ($self->{'arms'} >= 2);
}
{
  my @x_negative_at_n = (undef,  undef, 5, 5, 6, 7, 8);
  sub x_negative_at_n {
    my ($self) = @_;
    return $x_negative_at_n[$self->{'arms'}];
  }
}
{
  my @y_negative_at_n = (undef,  6, 12, 18, 11, 9, 10);
  sub y_negative_at_n {
    my ($self) = @_;
    return $y_negative_at_n[$self->{'arms'}];
  }
}
sub dx_minimum {
  my ($self) = @_;
  return ($self->{'arms'} == 1 ? -1 : -2);
}
use constant dx_maximum => 2;
use constant dy_minimum => -1;
use constant dy_maximum => 1;

sub sumxy_minimum {
  my ($self) = @_;
  # arm 0 and arm 1 are always above X+Y=0 opposite diagonal, which is +120 deg
  return ($self->{'arms'} <= 2 ? 0 : undef);
}
sub diffxy_minimum {
  my ($self) = @_;
  # arm 0 remains below the X-Y leading diagonal, being +60 deg
  return ($self->{'arms'} <= 1 ? 0 : undef);
}

sub _UNDOCUMENTED__dxdy_list {
  my ($self) = @_;
  return ($self->{'arms'} == 1
          ? Math::PlanePath::_UNDOCUMENTED__dxdy_list_three()
          : Math::PlanePath::_UNDOCUMENTED__dxdy_list_six());
}
{
  my @_UNDOCUMENTED__dxdy_list_at_n = (undef, 3, 7, 10, 7, 8, 5);
  sub _UNDOCUMENTED__dxdy_list_at_n {
    my ($self) = @_;
    return $_UNDOCUMENTED__dxdy_list_at_n[$self->{'arms'}];
  }
}
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;

# arms=1 curve goes at 0,120,240 degrees
# arms=2 second +60 to 60,180,300 degrees
# so when arms==1 dir maximum is 240 degrees
sub dir_maximum_dxdy {
  my ($self) = @_;
  return ($self->{'arms'} == 1
          ? (-1,-1)    # 0,2,4 only           South-West
          : ( 1,-1));  # rotated to 1,3,5 too South-East
}

use constant turn_any_straight => 0; # never straight


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

sub new {
  my $self = shift->SUPER::new(@_);
  $self->{'arms'} = max(1, min(6, $self->{'arms'} || 1));
  return $self;
}

my @dir6_to_dx = (2, 1,-1,-2, -1, 1);
my @dir6_to_dy = (0, 1, 1, 0, -1,-1);

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

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

  my $zero = ($n * 0);  # inherit bignum 0
  my $i;             # X
  my $j = $zero;             # +60
  my $k = $zero;             # +120
  my $pow = $zero + 1;  # inherit bignum 1

  # initial rotation from arm number
  my $rot;
  {
    my $int = int($n);
    $i = $n - $int;   # frac, inherit possible BigFloat
    $n = $int;        # BigFloat int() gives BigInt, use that
    $rot = _divrem_mutate ($n, $self->{'arms'});
  }

  # even si = pow, sj = 0, sk = 0
  # odd  si = pow, sj = 0, sk = -pow

  my $even = 1;
  my @n = digit_split_lowtohigh($n,3);
  while (@n) {
    my $digit = shift @n;
    ### at: "$i, $j, $k  even digit $digit"
    if ($digit == 1) {
      ($i,$j,$k) = ($pow-$j, -$k, $i);  # rotate +120 and add
    } elsif ($digit == 2) {
      $j += $pow;  # add rotated +60
    }

    last unless @n;
    $digit = shift @n;
    if ($digit == 1) {
      ($i,$j,$k) = ($pow+$k, $pow-$i, -$j);  # rotate -120 and add
    } elsif ($digit == 2) {
      $i += $pow;   # add * b
      $k -= $pow;
    }
    $pow *= 3;
  }

  ### final: "$i, $j, $k"
  ### is: (2*$i + $j - $k).", ".($j+$k)

  ### $rot
  if ($rot >= 3) {
    ($i,$j,$k) = (-$i,-$j,-$k);
    $rot -= 3;
  }
  if ($rot == 1)    { ($i,$j,$k) = (-$k,$i,$j); } # rotate +60
  elsif ($rot == 2) { ($i,$j,$k) = (-$j,-$k, $i); } # rotate +128

  return (2*$i + $j - $k, $j+$k);
}

# all even points when arms==6
sub xy_is_visited {
  my ($self, $x, $y) = @_;
  if ($self->{'arms'} == 6) {
    return xy_is_even($self,$x,$y);
  } else {
    return defined($self->xy_to_n($x,$y));
  }
}

sub xy_to_n {
  return scalar((shift->xy_to_n_list(@_))[0]);
}
sub xy_to_n_list {
  my ($self, $x,$y) = @_;
  ### AlternateTerdragon xy_to_n_list(): "$x, $y"

  $x = round_nearest($x);
  $y = round_nearest($y);
  {
    # nothing at an odd point, and trap overflows in $x+$y dividing out b
    my $sum = abs($x) + abs($y);
    if (is_infinite($sum)) { return $sum; }  # infinity
    if ($sum % 2) { return; }
  }

  if ($x==0 && $y==0) {
    return 0 .. $self->{'arms'}-1;
  }

  my $arms_count = $self->arms_count;
  my $zero = ($x * 0 * $y); # inherit bignum 0

  my @n_list;
  foreach my $d (0,1,2) {
    my ($ndigits,$arm) = _xy_d_to_ndigits_and_arm($x,$y,$d);
    next if $arm >= $arms_count;
    if ($arm & 1) {
      ### flip ...
      @$ndigits = map {2-$_} @$ndigits;
    }
    push @n_list,
      digit_join_lowtohigh($ndigits, 3, $zero) * $arms_count + $arm;
  }

  ### unsorted n_list: @n_list
  return sort {$a<=>$b} @n_list;
}

my @digit_to_x = ([0,2,1],  [0,-1,-2],  [0,-1, 1]);
my @digit_to_y = ([0,0,1],  [0, 1, 0],  [0,-1,-1]);

# $d = 0,1,2 for segment leaving $x,$y at direction $d*120 degrees.
# For odd arms the digits are 0<->2 reversals.
sub _xy_d_to_ndigits_and_arm {
  my ($x,$y, $d) = @_;
  ### _xy_d_to_ndigits_and_arm(): "$x,$y d=$d"
  my @ndigits;
  my $arm;
  for (;;) {
    ### at: "$x,$y d=$d"
    if ($x==0 && $y==0) { $arm = 2*$d; last; }
    if ($d==2 && $x==1  && $y==1) { $arm = 1; last; }
    if ($d==0 && $x==-2 && $y==0) { $arm = 3; last; }
    if ($d==1 && $x==1  && $y==-1) { $arm = 5; last; }
    my $a = $x % 3;          # z mod b = -x mod 3
    if ($a) { $a = 3-$a; }
    push @ndigits, $a;

    if ($a==1) { $d = ($d-1) % 3; }
    ### a: $a
    ### new d: $d

    $x -= $digit_to_x[$d]->[$a];
    $y -= $digit_to_y[$d]->[$a];
    ### subtract: "$digit_to_x[$d]->[$a],$digit_to_y[$d]->[$a] to $x,$y"

    ### assert: ($x+$y) % 2 == 0
    ### assert: $x % 3 == 0
    ### assert: ($y-$x/3) % 2 == 0
    ### assert: (3*$y-$x) % 6 == 0

    ($x,$y) = (($x+$y)/2,    # divide b = w6+1
               ($y-$x/3)/2);

    $y = -$y;
    $d = (-$d) % 3;
  }
  if (scalar(@ndigits) & 1) { $arm = (6-$arm) % 6; }
  ### $arm
  ### @ndigits
  return (\@ndigits, $arm);
}

# not exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  ### AlternateTerdragon rect_to_n_range(): "$x1,$y1  $x2,$y2"
  my $xmax = int(max(abs($x1),abs($x2)));
  my $ymax = int(max(abs($y1),abs($y2)));
  return (0,
          ($xmax*$xmax + 3*$ymax*$ymax + 1)
          * 2
          * $self->{'arms'});
}

my @digit_to_nextturn = (2,-2);
sub n_to_dxdy {
  my ($self, $n) = @_;
  ### AlternateTerdragon n_to_dxdy(): $n

  if ($n < 0) {
    return;  # first direction at N=0
  }
  if (is_infinite($n)) {
    return ($n,$n);
  }

  my $int = int($n);  # integer part
  $n -= $int;         # fraction part

  # initial direction from arm
  my $dir6 = _divrem_mutate ($int, $self->{'arms'});

  my @ndigits = digit_split_lowtohigh($int,3);
  foreach my $i (0 .. $#ndigits) {
    if ($ndigits[$i] == 1) {
      $dir6 += 2*($i&1 ? -1 : 1);   # count 1s for total turn
    }
  }
  $dir6 %= 6;
  my $dx = $dir6_to_dx[$dir6];
  my $dy = $dir6_to_dy[$dir6];

  if ($n) {
    ### fraction part: $n

    # find lowest non-2 digit, or zero if all 2s or no digits at all
    my $above = scalar(@ndigits);
    foreach my $i (0 .. $#ndigits) {
      if ($ndigits[$i] != 2) {
        ### lowest non-2: "at i=$i digit=$ndigits[$i]"
        $above = $ndigits[$i] ^ $i;
        last;
      }
    }

    $dir6 = ($dir6 + $digit_to_nextturn[$above & 1]) % 6;
    ### $above
    ### $dir6

    $dx += $n*($dir6_to_dx[$dir6] - $dx);
    $dy += $n*($dir6_to_dy[$dir6] - $dy);
  }
  return ($dx, $dy);
}


#-----------------------------------------------------------------------------
# eg. arms=5 0 .. 5*3^k    step by 5s
#            1 .. 5*3^k+1  step by 5s
#            4 .. 5*3^k+4  step by 5s
#
sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  (3**$level + 1) * $self->{'arms'} - 1);
}
sub n_to_level {
  my ($self, $n) = @_;
  if ($n < 0) { return undef; }
  if (is_infinite($n)) { return $n; }
  $n = round_nearest($n);
  _divrem_mutate ($n, $self->{'arms'});
  my ($pow, $exp) = round_up_pow ($n, 3);
  return $exp;
}

1;
__END__