File Coverage

blib/lib/Math/PlanePath/TerdragonMidpoint.pm

Criterion	Covered	Total	%
statement	84	137	61.3
branch	8	30	26.6
condition	7	13	53.8
subroutine	22	33	66.6
pod	11	11	100.0
total	132	224	58.9

# 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=TerdragonMidpoint --lines --scale=40
#
# math-image --path=TerdragonMidpoint --all --output=numbers_dash --size=78x60
# math-image --path=TerdragonMidpoint,arms=6 --all --output=numbers_dash --size=78x60


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

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

use Math::PlanePath::Base::Generic
  'is_infinite',
  'round_nearest';
use Math::PlanePath::Base::Digits
  'digit_join_lowtohigh',
  'round_up_pow';
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;

# 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',
                                       } ];

{
  my @x_negative_at_n = (undef, 12, 5, 2, 2, 2, 2);
  sub x_negative_at_n {
    my ($self) = @_;
    return $x_negative_at_n[$self->{'arms'}];
  }
}
{
  my @y_negative_at_n = (undef, 158, 73, 17, 7, 4, 4);
  sub y_negative_at_n {
    my ($self) = @_;
    return $y_negative_at_n[$self->{'arms'}];
  }
}
use constant sumabsxy_minimum => 2; # X=2,Y=0 or X=1,Y=1
sub rsquared_minimum {
  my ($self) = @_;
  return ($self->arms_count < 2
          ? 4   # 1 arm, minimum X=2,Y=0
          : 2); # 2 or more arms, minimum X=1,Y=1
}

use constant dx_minimum => -2;
sub dx_maximum {
  my ($self) = @_;
  return ($self->{'arms'} == 1 ? 1 : 2);
}
use constant dy_minimum => -1;
use constant dy_maximum => 1;

sub _UNDOCUMENTED__dxdy_list {
  my ($self) = @_;
  return ($self->{'arms'} == 1
          ? (1,1,   # NE
             -2,0,  # W
             1,-1)  # SE
          : Math::PlanePath::_UNDOCUMENTED__dxdy_list_six());
}
{
  my @_UNDOCUMENTED__dxdy_list_at_n = (undef,
                                        12, 25, 37,
                                        15, 18, 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 60,180,300 degrees
# arms=2 second +60 to 120,240,0 degrees
# so when arms==1 dir minimum is 60 degrees North-East
#
sub dir_minimum_dxdy {
  my ($self) = @_;
  return ($self->{'arms'} == 1
          ? (1,1)     # North-East
          : (1,0));   # East
}
use constant dir_maximum_dxdy => (1,-1); # South-East

sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  # N=5 first right, and on multi-arms 10,15,20,25,30
  return 5*$self->arms_count;
}


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

# Not quite.
# # all even points when arms==3
# use Math::PlanePath::TerdragonCurve;
# *xy_is_visited = \&Math::PlanePath::TerdragonCurve::xy_is_visited;

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

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

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

  {
    my $int = int($n);
    if ($n != $int) {
      my ($x1,$y1) = $self->n_to_xy($int);
      my ($x2,$y2) = $self->n_to_xy($int+$self->{'arms'});
      my $frac = $n - $int;  # inherit possible BigFloat
      my $dx = $x2-$x1;
      my $dy = $y2-$y1;
      return ($frac*$dx + $x1, $frac*$dy + $y1);
    }
    $n = $int; # BigFloat int() gives BigInt, use that
  }

  # ENHANCE-ME: own code ...
  #
  require Math::PlanePath::TerdragonCurve;
  my ($x1,$y1) = $self->Math::PlanePath::TerdragonCurve::n_to_xy($n);
  my ($x2,$y2) = $self->Math::PlanePath::TerdragonCurve::n_to_xy($n+$self->{'arms'});

  # dx = x2-x1
  # X = 2 * (x1 + dx/2)
  #   = 2 * (x1 + x2/2 - x1/2)
  #   = 2 * (x1/2 + x2/2)
  #   = x1+x2
  return ($x1+$x2,
          $y1+$y2);
}

# sub n_to_xy {
#   my ($self, $n) = @_;
#   ### TerdragonMidpoint n_to_xy(): $n
#
#   if ($n < 0) { return; }
#   if (is_infinite($n)) { return ($n, $n); }
#
#   my $frac;
#   {
#     my $int = int($n);
#     $frac = $n - $int;  # inherit possible BigFloat
#     $n = $int;          # BigFloat int() gives BigInt, use that
#   }
#
#   my $zero = ($n * 0);  # inherit bignum 0
#
#   ($n, my $rot) = _divrem ($n, $self->{'arms'});
#
#   # ENHANCE-ME: sx,sy just from len,len
#   my @digits;
#   my @sx;
#   my @sy;
#   {
#     my $sx = $zero + 1;
#     my $sy = -$sx;
#     while ($n) {
#       push @digits, ($n % 2);
#       push @sx, $sx;
#       push @sy, $sy;
#       $n = int($n/2);
#
#       # (sx,sy) + rot+90(sx,sy)
#       ($sx,$sy) = ($sx - $sy,
#                    $sy + $sx);
#     }
#   }
#
#   ### @digits
#   my $rev = 0;
#   my $x = $zero;
#   my $y = $zero;
#   my $above_low_zero = 0;
#
#   for (my $i = $#digits; $i >= 0; $i--) {     # high to low
#     my $digit = $digits[$i];
#     my $sx = $sx[$i];
#     my $sy = $sy[$i];
#     ### at: "$x,$y  $digit   side $sx,$sy"
#     ### $rot
#
#     if ($rot & 2) {
#       $sx = -$sx;
#       $sy = -$sy;
#     }
#     if ($rot & 1) {
#       ($sx,$sy) = (-$sy,$sx);
#     }
#     ### rotated side: "$sx,$sy"
#
#     if ($rev) {
#       if ($digit) {
#         $x += -$sy;
#         $y += $sx;
#         ### rev add to: "$x,$y next is still rev"
#       } else {
#         $above_low_zero = $digits[$i+1];
#         $rot ++;
#         $rev = 0;
#         ### rev rot, next is no rev ...
#       }
#     } else {
#       if ($digit) {
#         $rot ++;
#         $x += $sx;
#         $y += $sy;
#         $rev = 1;
#         ### plain add to: "$x,$y next is rev"
#       } else {
#         $above_low_zero = $digits[$i+1];
#       }
#     }
#   }
#
#   # Digit above the low zero is the direction of the next turn, 0 for left,
#   # 1 for right.
#   #
#   ### final: "$x,$y  rot=$rot  above_low_zero=".($above_low_zero||0)
#
#   if ($rot & 2) {
#     $frac = -$frac;  # rotate 180
#     $x -= 1;
#   }
#   if (($rot+1) & 2) {
#     # rot 1 or 2
#     $y += 1;
#   }
#   if (!($rot & 1) && $above_low_zero) {
#     $frac = -$frac;
#   }
#   $above_low_zero ^= ($rot & 1);
#   if ($above_low_zero) {
#     $y = $frac + $y;
#   } else {
#     $x = $frac + $x;
#   }
#
#   ### rotated offset: "$x_offset,$y_offset   return $x,$y"
#   return ($x,$y);
# }


# w^2 = -1+w
# c = (X-Y)/2  x=2c+d
# d = Y        y=d
# (c+dw)/(w+1)
# = (c+dw)*(2-w)/3
#   = (2c-cw + 2dw-dw^2) / 3
#   = (2c-cw + 2dw-d(w-1)) / 3
#   = (2c-cw + 2dw-dw+d)) / 3
#   = (2c+d + w(-c + 2d-d)) / 3
#   = (2c+d + w(d-c)) / 3
#
#   = (x-y+y + w(y - (x-y)/2)) / 3
#   = (x + w((2y-x+y)/2)) / 3
#   = (x + w((3y-x)/2)) / 3
# then
# xq = 2c+d
#    = (2x + (3y-x)/2 ) / 3
#    = (4x + 3y-x)/6
#    = (3x+3y)/6
#    = (x+y)/2
# yq = d = (3y-x)/6
#
# (-1+5w)(2-w)    x=2*-1+5=3,y=5
#    = -2+w+10w-5w^2
#    = -2+11w-5(w-1)
#    = -2+11w-5w+5
#    = 3+6w -> 1+2w
# c=2*-1+5=3 d=-1+5=4
# x=2*1+2=4 y=3
#
# (w+1)*(2-w)
#   = 2w-w^2+2-w
#   = 2w-(w-1)+2-w
#   = 2w-w+1+2-w
#   = 3 -> 1   x=2
#
# 3w*(2-w)         x=3,y=3 div x=3,y(3+3)/2=3
#   = 6w-3w^2
#   = 6w-3(w-1)
#   = 6w-3w+3
#   = 3w+3 -> w+1  x=3,y=1
#
# (w+1)(w+1)
#   = w^2+2w+1
#   = w-1+2w+1
#   = 3w
#

#
# x=3,y=3  (x+y)/2=3

#              X=-3 -2 -1  0  1  2  3
my @yx_to_arm = ([9, 9, 9, 4, 9, 9, 9],  # Y=-2
                 [3, 9, 9, 9, 9, 9, 5],  # Y=-1
                 [9, 9, 9, 9, 9, 9, 9],  # Y=0
                 [2, 9, 9, 9, 9, 9, 0],  # Y=1
                 [9, 9, 9, 1, 9, 9, 9],  # Y= 2
                );

# my @yx_to_dxdy = (undef,undef, -1,1, undef,undef,  0,0, undef,undef, 1,-1,
#                   1,1,  0,0,       -1,-1, -2,0,         0,0,  2,0,
#                   undef,undef, 1,-1, undef,undef, -1,1, undef,undef,  0,0,
#                   0,0,  2,0,         1,1,  0,0,       -1,-1, -2,0,
#                   undef,undef,  0,0, undef,undef, 1,-1, undef,undef, -1,1,
#                   -1,-1, -2,0,         0,0,  2,0,         1,1,  0,0,
#                  );

my @yx_to_dxdy  # 12 each row
  = (undef,undef, undef,undef, 1,1,  undef,undef, undef,undef, undef,undef,
     0,0,  undef,undef, undef,undef, undef,undef, -1,-1, undef,undef,
     undef,undef, -1,1, undef,undef, 0,0,  undef,undef, 1,-1,
     undef,undef, 2,0,  undef,undef, 0,0,  undef,undef, -2,0,
     0,0,  undef,undef, undef,undef, undef,undef, -1,-1, undef,undef,
     undef,undef, undef,undef, 1,1,  undef,undef, undef,undef, undef,undef,
     undef,undef, 2,0,  undef,undef, 0,0,  undef,undef, -2,0,
     undef,undef, -1,1, undef,undef, 0,0,  undef,undef, 1,-1,
     undef,undef, undef,undef, 1,1,  undef,undef, undef,undef, undef,undef,
     0,0,  undef,undef, undef,undef, undef,undef, -1,-1, undef,undef,
     undef,undef, -1,1, undef,undef, 0,0,  undef,undef, 1,-1,
     undef,undef, 2,0,  undef,undef, 0,0,  undef,undef, -2,0,
     0,0,  undef,undef, undef,undef, undef,undef, -1,-1, undef,undef,
     undef,undef, undef,undef, 1,1,  undef,undef, undef,undef, undef,undef,
     undef,undef, 2,0,  undef,undef, 0,0,  undef,undef, -2,0,
     undef,undef, -1,1, undef,undef, 0,0,  undef,undef, 1,-1,
     undef,undef, undef,undef, 1,1,  undef,undef, undef,undef, undef,undef,
     0,0,  undef,undef, undef,undef, undef,undef, -1,-1, undef,undef,
     undef,undef, -1,1, undef,undef, 0,0,  undef,undef, 1,-1,
     undef,undef, 2,0,  undef,undef, 0,0,  undef,undef, -2,0,
     0,0,  undef,undef, undef,undef, undef,undef, -1,-1, undef,undef,
     undef,undef, undef,undef, 1,1,  undef,undef, undef,undef, undef,undef,
     undef,undef, 2,0,  undef,undef, 0,0,  undef,undef, -2,0,
     undef,undef, -1,1, undef,undef, 0,0,  undef,undef, 1,-1,
    );

my @x_to_digit = (1, 2, 0);  # digit = X+1 mod 3

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

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

  if (is_infinite($x)) {
    return $x;  # infinity
  }
  if (is_infinite($y)) {
    return $y;  # infinity
  }
  my $zero = ($x * 0 * $y); # inherit bignum 0
  my @ndigits;     # low to high;

  for (;;) {
    my $digit = $x_to_digit[$x%3];

    my $k = 2*(12*($y%12) + ($x%12));
    my $dx = $yx_to_dxdy[$k++];
    if (! defined $dx) {
      ### not a visited point: "k=$k"
      ### x mod 12: $x%12
      ### y mod 12: $y%12
      return undef;
    }

    ### at: "$x,$y (k=$k)  digit=$digit k=$k  offset=$yx_to_dxdy[$k-1],$yx_to_dxdy[$k] to ".($x+$yx_to_dxdy[$k-1]).",".($y+$yx_to_dxdy[$k])

    push @ndigits, $digit;
    $x += $dx;
    $y += $yx_to_dxdy[$k];

    last if ($x <= 3 && $x >= -3 && $y <= 2 && $y >= -2);

    ### assert: ($x+$y) % 2 == 0
    ### assert: $x % 3 == 0
    ### assert: (3 * $y - $x) % 6 == 0
    ($x,$y) = (($x+$y)/2,    # divide w+1
               ($y-$x/3)/2);
    ### divide down to: "$x,$y"
  }

  ### final: "xy=$x,$y"

  my $arm = $yx_to_arm[$y+2][$x+3] || 0;   # 0 to 5
  ### $arm

  my $arms_count = $self->arms_count;
  if ($arm >= $arms_count) {
    return undef;
  }
  if ($arm & 1) {
    ### flip ...
    @ndigits = map {2-$_} @ndigits;
  }

  return digit_join_lowtohigh(\@ndigits, 3, $zero) * $arms_count + $arm;
}

# quarter size of TerdragonCurve
#
# not exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  ### TerdragonCurve 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,
          int (($xmax*$xmax + 3*$ymax*$ymax + 1)
               / 2)
          * $self->{'arms'});
}

#-----------------------------------------------------------------------------
# level_to_n_range()

# 3^level segments, one midpoint each
# arms*3^level when multi-arm
# numbered starting 0
#
sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  3**$level * $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+1, 3);
  return $exp;
}

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