File Coverage

blib/lib/Math/PlanePath/SierpinskiArrowhead.pm

Criterion	Covered	Total	%
statement	123	173	71.1
branch	41	74	55.4
condition	12	14	85.7
subroutine	22	34	64.7
pod	17	17	100.0
total	215	312	68.9

# Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 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::SierpinskiArrowhead;
use 5.004;
use strict;
use Carp 'croak';

#use List::Util 'max';
*max = \&Math::PlanePath::_max;

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

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

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


# Note: shared by SierpinskiArrowheadCentres
use constant parameter_info_array =>
  [ { name      => 'align',
      share_key => 'align_trld',
      display   => 'Align',
      type      => 'enum',
      default   => 'triangular',
      choices   => ['triangular','right','left','diagonal'],
      choices_display => ['Triangular','Right','Left','Diagonal'],
    },
  ];

use constant n_start => 0;
use constant class_y_negative => 0;

my %x_negative = (triangular => 1,
                  left       => 1,
                  right      => 0,
                  diagonal   => 0);
# Note: shared by SierpinskiArrowheadCentres
sub x_negative {
  my ($self) = @_;
  return $x_negative{$self->{'align'}};
}
{
  my %x_negative_at_n = (triangular => 3,
                         # right      => undef,
                         left       => 2,
                         # diagonal   => undef,
                        );
  sub x_negative_at_n {
    my ($self) = @_;
    return $x_negative_at_n{$self->{'align'}};
  }
}

use constant sumxy_minimum => 0;  # triangular X>=-Y
use Math::PlanePath::SierpinskiTriangle;
*x_maximum      = \&Math::PlanePath::SierpinskiTriangle::x_maximum;
*diffxy_maximum = \&Math::PlanePath::SierpinskiTriangle::diffxy_maximum;

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

{
  my %_UNDOCUMENTED__dxdy_list
    = (triangular  => [ 2,0,   # E   N=4   six directions
                        1,1,   # NE  N=0
                        -1,1,  # NW  N=2
                        -2,0,  # W   N=1
                        -1,-1, # SW  N=15
                        1,-1,  # SE  N=6
                      ],
       right     => [ 1,0,   # E   N=4
                      1,1,   # NE  N=0
                      0,1,   # N   N=2
                      -1,0,  # W   N=1
                      -1,-1, # SW  N=15
                      0,-1,  # S   N=6
                    ],
       left      => [ 1,0,    # E   N=4
                      0,1,    # N   N=0
                      -1,1,   # NW  N=2
                      -1,0,   # W   N=1
                      0,-1,   # S   N=15
                      1,-1,   # SE  N=6
                    ],
       diagonal  => [ 1,0,   # E  N=0
                      0,1,   # N  N=2
                      -1,1,  # NW  N=1
                      -1,0,  # W  N=15
                      0,-1,  # S  N=6
                      1,-1,  # SE  N=4
                    ],
      );
  sub _UNDOCUMENTED__dxdy_list {
    my ($self) = @_;
    return @{$_UNDOCUMENTED__dxdy_list{$self->{'align'}}};
  }
}
use constant _UNDOCUMENTED__dxdy_list_at_n => 15;

sub absdx_minimum {
  my ($self) = @_;
  return ($self->{'align'} eq 'triangular' ? 1 : 0);
}
sub absdx_maximum {
  my ($self) = @_;
  return ($self->{'align'} eq 'triangular' ? 2 : 1);
}

{
  my %dsumxy_minimum = (triangular => -2,
                        left       => -1,
                        right      => -2,
                        diagonal   => -1,
                       );
  sub dsumxy_minimum {
    my ($self) = @_;
    return $dsumxy_minimum{$self->{'align'}};
  }
}
{
  my %dsumxy_maximum = (triangular => 2,
                        left       => 1,
                        right      => 2,
                        diagonal   => 1,
                       );
  sub dsumxy_maximum {
    my ($self) = @_;
    return $dsumxy_maximum{$self->{'align'}};
  }
}

{
  my %ddiffxy_minimum = (triangular => -2,
                         left       => -2,
                         right      => -1,
                         diagonal   => -2,
                        );
  sub ddiffxy_minimum {
    my ($self) = @_;
    return $ddiffxy_minimum{$self->{'align'}};
  }
}
{
  my %ddiffxy_maximum = (triangular => 2,
                        left       => 2,
                        right      => 1,
                        diagonal   => 2,
                       );
  sub ddiffxy_maximum {
    my ($self) = @_;
    return $ddiffxy_maximum{$self->{'align'}};
  }
}

sub dir_maximum_dxdy {
  my ($self) = @_;
  return ($self->{'align'} eq 'right'
          ? (0,-1)   # South
          : (1,-1)); # South-East
}

use constant turn_any_straight => 0; # never straight


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

# Note: shared by SierpinskiArrowheadCentres
sub new {
  my $self = shift->SUPER::new(@_);
  my $align = ($self->{'align'} ||= 'triangular');
  if (! exists $x_negative{$align}) {
    croak "Unrecognised align option: ", $align;
  }
  return $self;
}

sub n_to_xy {
  my ($self, $n) = @_;
  ### SierpinskiArrowhead n_to_xy(): $n
  if ($n < 0) {
    return;
  }
  if (is_infinite($n)) {
    return ($n,$n);
  }

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

  if (my @digits = digit_split_lowtohigh($n,3)) {
    my $len = 1;
    for (;;) {
      my $digit = shift @digits;  # low to high

      ### odd right: "$x,$y  len=$len"
      ### $digit
      if ($digit == 0) {

      } elsif ($digit == 1) {
        $x = $len - $x;  # mirror and offset
        $y += $len;

      } else {
        ($x,$y) = (($x+3*$y)/-2,             # rotate +120
                   ($x-$y)/2    + 2*$len);
      }

      @digits || last;
      $len *= 2;
      $digit = shift @digits;  # low to high

      ### odd left: "$x,$y  len=$len"
      ### $digit
      if ($digit == 0) {

      } elsif ($digit == 1) {
        $x = - $x - $len;  # mirror and offset
        $y += $len;

      } else {
        ($x,$y) = ((3*$y-$x)/2,              # rotate -120
                   ($x+$y)/-2  + 2*$len)
      }

      @digits || last;
      $len *= 2;
    }
  }

  ### final: "$x,$y"
  if ($self->{'align'} eq 'right') {
    return (($x+$y)/2, $y);
  } elsif ($self->{'align'} eq 'left') {
    return (($x-$y)/2, $y);
  } elsif ($self->{'align'} eq 'diagonal') {
    return (($x+$y)/2, ($y-$x)/2);
  } else { # triangular
    return ($x,$y);
  }
}

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

  if ($y < 0) {
    return undef;
  }

  if ($self->{'align'} eq 'left') {
    if ($x > 0) {
      return undef;
    }
    $x = 2*$x + $y; # adjust to triangular style

  } elsif ($self->{'align'} eq 'triangular') {
    if (($x%2) != ($y%2)) {
      return undef;
    }

  } else {
    # right or diagonal
    if ($x < 0) {
      return undef;
    }
    if ($self->{'align'} eq 'right') {
      $x = 2*$x - $y;
    } else { # diagonal
      ($x,$y) = ($x-$y, $x+$y);
      }
  }
  ### adjusted xy: "$x,$y"

  # On row Y=2^k the points belong to belong in the level below except for
  # the endmost X=Y or X=-Y.  For example Y=4 has N=6 which is in the level
  # below, but at the end has N=9 belongs to the level above.  So $y-1 puts
  # Y=2^k into the level below and +($y==abs($x)) pushes the end back up to
  # the next.
  #
  my ($len, $level) = round_down_pow ($y-1 + ($y==abs($x)),
                                      2);
  ### pow2 round down: $y-1+($y==abs($x))
  ### $len
  ### $level

  if (is_infinite($level)) {
    return $level;
  }

  my $n = 0;
  while ($level-- >= 0) {
    ### at: "$x,$y  level=$level  len=$len"
    $n *= 3;

    if ($y < 0 || $x < -$y || $x > $y) {
      ### out of range
      return undef;
    }
    if ($y < $len + !($x==$y||$x==-$y)) {
      ### digit 0, first triangle, no change

    } else {
      if ($level & 1) {
        ### odd level
        if ($x > 0) {
          ### digit 1, right triangle
          $n += 1;
          $y -= $len;
          $x = - ($x-$len);
          ### shift right and mirror to: "$x,$y"
        } else {
          ### digit 2, left triangle
          $n += 2;
          $y -= 2*$len;
          ### shift down to: "$x,$y"
          ($x,$y) = ((3*$y-$x)/2,   # rotate -120
                     ($x+$y)/-2);
          ### rotate to: "$x,$y"
        }
      } else {
        ### even level
        if ($x < 0) {
          ### digit 1, left triangle
          $n += 1;
          $y -= $len;
          $x = - ($x+$len);
          ### shift right and mirror to: "$x,$y"
        } else {
          ### digit 2, right triangle
          $n += 2;
          $y -= 2*$len;
          ### shift down to: "$x,$y"
          ($x,$y) = (($x+3*$y)/-2,             # rotate +120
                     ($x-$y)/2);
          ### now: "$x,$y"
        }
      }
    }

    $len /= 2;
  }

  if ($x == 0 && $y == 0) {
    return $n;
  } else {
    return undef;
  }
}

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

  $y1 = round_nearest ($y1);
  $y2 = round_nearest ($y2);
  if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2

  if ($self->{'align'} eq 'diagonal') {
    $y2 += max (round_nearest ($x1),
                round_nearest ($x2));
  }

  unless ($y2 >= 0) {
    ### rect all negative, no N ...
    return (1, 0);
  }

  my ($pow,$exp) = round_down_pow ($y2-1, 2);
  ### $y2
  ### $level
  return (0, 3**($exp+1));
}

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

sub level_to_n_range {
  my ($self, $level) = @_;
  return (0, 3**$level);
}
sub n_to_level {
  my ($self, $n) = @_;
  if ($n < 0) { return undef; }
  if (is_infinite($n)) { return $n; }
  $n = round_nearest($n);
  my ($pow, $exp) = round_up_pow ($n, 3);
  return $exp;
}

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