File Coverage

blib/lib/Math/PlanePath/SierpinskiArrowheadCentres.pm

Criterion	Covered	Total	%
statement	119	145	82.0
branch	37	56	66.0
condition	3	9	33.3
subroutine	18	22	81.8
pod	8	8	100.0
total	185	240	77.0

# 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=SierpinskiArrowheadCentres --lines --scale=10
#
# math-image --path=SierpinskiArrowheadCentres --all --output=numbers_dash
# math-image --path=SierpinskiArrowheadCentres --all --text --size=80


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

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

use vars '$VERSION', '@ISA';
$VERSION = 129;
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',
  'digit_join_lowtohigh';

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


use Math::PlanePath::SierpinskiArrowhead;
*parameter_info_array  # align parameter
  = \&Math::PlanePath::SierpinskiArrowhead::parameter_info_array;
*new = \&Math::PlanePath::SierpinskiArrowhead::new;

use constant n_start => 0;
use constant class_y_negative => 0;
*x_negative = \&Math::PlanePath::SierpinskiArrowhead::x_negative;
{
  my %x_negative_at_n = (triangular => 2,
                         # right      => undef,
                         left       => 2,
                         # diagonal   => undef,
                        );
  sub x_negative_at_n {
    my ($self) = @_;
    return $x_negative_at_n{$self->{'align'}};
  }
}
*x_maximum  = \&Math::PlanePath::SierpinskiArrowhead::x_maximum;
use constant sumxy_minimum => 0;  # triangular X>=-Y
use Math::PlanePath::SierpinskiTriangle;
*diffxy_maximum = \&Math::PlanePath::SierpinskiTriangle::diffxy_maximum;

use constant dy_minimum => -1;
use constant dy_maximum => 1;
*dx_minimum = \&Math::PlanePath::SierpinskiArrowhead::dx_minimum;
*dx_maximum = \&Math::PlanePath::SierpinskiArrowhead::dx_maximum;

*_UNDOCUMENTED__dxdy_list = \&Math::PlanePath::SierpinskiArrowhead::_UNDOCUMENTED__dxdy_list; # same
use constant 1.02 _UNDOCUMENTED__dxdy_list_at_n => 15;

*absdx_minimum = \&Math::PlanePath::SierpinskiArrowhead::absdx_minimum;
*absdx_maximum = \&Math::PlanePath::SierpinskiArrowhead::absdx_maximum;
*dsumxy_minimum = \&Math::PlanePath::SierpinskiArrowhead::dsumxy_minimum;
*dsumxy_maximum = \&Math::PlanePath::SierpinskiArrowhead::dsumxy_maximum;
sub ddiffxy_minimum {
  my ($self) = @_;
  return ($self->{'align'} eq 'right' ? -1 : -2);
}
sub ddiffxy_maximum {
  my ($self) = @_;
  return ($self->{'align'} eq 'right' ? 1 : 2);
}
*dir_maximum_dxdy = \&Math::PlanePath::SierpinskiArrowhead::dir_maximum_dxdy;

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

# States as multiples of 3 so that state+digit is the lookup for next state
# and x,y bit.
#
# 0        3           6        9           12       15
#
# 8        0           4        4           0        8
# |        |           |\       |\           \        \
# 7-6      1-2         3 5      5 3         2-1      6-7
#    \        \        |  \     |  \        |        |
# 1   5    7   3       2   6    6   2       3   7    5   1
# |\   \   |\   \       \  |     \  |       |   |\   |   |\
# 0 2-3-4  8 6-5-4     0-1 7-8  8-7 1-0     4-5-6 8  4-3-2 0

#  15                   6                    3
#  6  0                 0 12                 12 6

#  0,1                  0,2                   1,2

my @next_state = (6,0,15,  12,3,9,   # 3,6
                  0,6,12,  15,9,3,   # 6,9
                  3,12,6,  9,15,0);  # 12,15
my @state_to_xbit = (0,1,0, 0,1,0,
                     0,0,1, 1,0,0,
                     0,0,1, 1,0,0);  # 12,15
my @state_to_ybit = (0,0,1, 1,0,0,
                     0,1,0, 0,1,0,
                     1,0,0, 0,0,1);  # 12,15

# dx,dy for digit==0 and digit==1 in each stage
my @state_to_dx;
my @state_to_dy;
foreach my $state (0,1, 3,4, 6,7, 9,10, 12,13, 15,16) {
  $state_to_dx[$state] = $state_to_xbit[$state+1] - $state_to_xbit[$state];
  $state_to_dy[$state] = $state_to_ybit[$state+1] - $state_to_ybit[$state];
}

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

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

  my @digits = digit_split_lowtohigh($int,3);
  my $state = ($#digits & 1 ? 6 : 0);
  ### @digits
  ### $state

  my (@x,@y); # bits low to high
  my $dirstate = $state ^ 6;  # if all digits==2

  foreach my $i (reverse 0 .. $#digits) {
    ### at: "x=".join(',',@x[($i+1)..$#digits])." y=".join(',',@y[($i+1)..$#digits])."  apply  i=$i state=$state digit=$digits[$i]"

    my $digit = $digits[$i];  # high to low
    $state += $digit;
    $x[$i] = $state_to_xbit[$state];
    $y[$i] = $state_to_ybit[$state];
    if ($digit != 2) {
      $dirstate = $state; # lowest non-2 digit
    }
    $state = $next_state[$state];
  }

  my $zero = $int * 0;
  my $x = $n*$state_to_dx[$dirstate] + digit_join_lowtohigh(\@x,2,$zero);
  my $y = $n*$state_to_dy[$dirstate] + digit_join_lowtohigh(\@y,2,$zero);

  if ($self->{'align'} eq 'right') {
    $y += $x;
  } elsif ($self->{'align'} eq 'left') {
    ($x,$y) = (-$y,$x+$y);
  } elsif ($self->{'align'} eq 'triangular') {
    ($x,$y) = ($x-$y,$x+$y);
  }
  return ($x,$y);
}

sub xy_to_n {
  my ($self, $x, $y) = @_;
  $x = round_nearest ($x);
  $y = round_nearest ($y);
  ### SierpinskiArrowheadCentres 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"


  my ($len, $level) = round_down_pow ($y, 2);
  ### pow2 round up: ($y + ($y==$x || $y==-$x))
  ### $len
  ### $level
  $level += 1;

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

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

    if ($y < 0 || $x < -$y || $x > $y) {
      ### out of range ...
      return undef;
    }

    if ($y < $len) {
      ### 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;
          $x += 1;
          $y -= 2*$len-1;
          ### 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;
          $x -= 1;
          $y -= 2*$len-1;
          ### shift down to: "$x,$y"
          ($x,$y) = (($x+3*$y)/-2,             # rotate +120
                     ($x-$y)/2);
          ### now: "$x,$y"
        }
      }
    }

    $level--;
    $len /= 2;
  }

  ### final: "$x,$y with n=$n"
  if ($x == 0 && $y == 0) {
    return $n;
  } else {
    return undef;
  }
}

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

  $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 ($len,$level) = round_down_pow ($y2, 2);
  ### $y2
  ### $level
  return (0, 3**($level+1) - 1);
}

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

# shared by SierpinskiTriangle
sub level_to_n_range {
  my ($self, $level) = @_;
  my $n_start = $self->n_start;
  return ($n_start,  $n_start + 3**$level - 1);
}
sub n_to_level {
  my ($self, $n) = @_;
  $n = $n - $self->n_start;
  if ($n < 0) { return undef; }
  if (is_infinite($n)) { return $n; }
  $n = round_nearest($n);
  my ($pow, $exp) = round_up_pow ($n+1, 3);
  return $exp;
}

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