File Coverage

blib/lib/Math/PlanePath/GosperReplicate.pm

Criterion	Covered	Total	%
statement	115	140	82.1
branch	24	34	70.5
condition	8	8	100.0
subroutine	23	25	92.0
pod	6	6	100.0
total	176	213	82.6

# 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=GosperReplicate --lines --scale=10
# math-image --path=GosperReplicate --all --output=numbers_dash
# math-image --path=GosperReplicate,numbering_type=rotate --all --output=numbers_dash
#

package Math::PlanePath::GosperReplicate;
use 5.004;
use strict;
use List::Util qw(max);
use POSIX 'ceil';
use Math::Libm 'hypot';
use Math::PlanePath::SacksSpiral;

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
  'round_up_pow',
  'digit_split_lowtohigh',
  'digit_join_lowtohigh';

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


use constant parameter_info_array =>
  [ { name            => 'numbering_type',
      display         => 'Numbering',
      share_key       => 'numbering_type_rotate',
      type            => 'enum',
      default         => 'fixed',
      choices         => ['fixed','rotate'],
      choices_display => ['Fixed','Rotate'],
      description     => 'Fixed or rotating sub-part numbering.',
    },
  ];

use constant n_start => 0;
*xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_even;

use constant x_negative_at_n => 3;
use constant y_negative_at_n => 5;
use constant absdx_minimum => 1;
use constant dir_maximum_dxdy => (3,-1);

#------------------------------------------------------------------------------
sub new {
  my $self = shift->SUPER::new (@_);
  $self->{'numbering_type'} ||= 'fixed';  # default
  return $self;
}

sub _digits_rotate_lowtohigh {
  my ($aref) = @_;
  my $rot = 0;
  foreach my $digit (reverse @$aref) {
    if ($digit) {
      $rot += $digit-1;
      $digit = ($rot % 6) + 1;  # mutate $aref
    }
  }
}
sub _digits_unrotate_lowtohigh {
  my ($aref) = @_;
  my $rot = 0;
  foreach my $digit (reverse @$aref) {
    if ($digit) {
      $digit = ($digit-1-$rot) % 6;  # mutate $aref
      $rot += $digit;
      $digit++;
    }
  }
}

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

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

  {
    my $int = int($n);
    ### $int
    ### $n
    if ($n != $int) {
      my ($x1,$y1) = $self->n_to_xy($int);
      my ($x2,$y2) = $self->n_to_xy($int+1);
      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
  }

  my $x = my $y = $n*0;  # inherit bigint from $n
  my $sx = $x + 2;  # 2
  my $sy = $x;      # 0

  # digit
  #       3   2
  #        \ /
  #     4---0---1
  #        / \
  #       5   6

  my @digits = digit_split_lowtohigh($n,7);
  if ($self->{'numbering_type'} eq 'rotate') {
    _digits_rotate_lowtohigh(\@digits);
  }

  foreach my $digit (@digits) {
    ### digit: "$digit  $x,$y  side $sx,$sy"

    if ($digit == 1) {
      ### right ...
      # $x = -$x;  # rotate 180
      # $y = -$y;
      $x += $sx;
      $y += $sy;
    } elsif ($digit == 2) {
      ### up right ...
      # ($x,$y) = ((3*$y-$x)/2,   # rotate -120
      #            ($x+$y)/-2);
      $x += ($sx - 3*$sy)/2;    # at +60
      $y += ($sx + $sy)/2;

    } elsif ($digit == 3) {
      ### up left ...
      # ($x,$y) = (($x+3*$y)/2,   # -60
      #            ($y-$x)/2);
      $x += ($sx + 3*$sy)/-2;   # at +120
      $y += ($sx - $sy)/2;

    } elsif ($digit == 4) {
      ### left
      $x -= $sx;                # at -180
      $y -= $sy;

    } elsif ($digit == 5) {
      ### down left
      # ($x,$y) = (($x-3*$y)/2,    # rotate +60
      #            ($x+$y)/2);
      $x += (3*$sy - $sx)/2;    # at -120
      $y += ($sx + $sy)/-2;

    } elsif ($digit == 6) {
      ### down right
      # ($x,$y) = (($x+3*$y)/-2,  # rotate +120
      #            ($x-$y)/2);
      $x += ($sx + 3*$sy)/2;    # at -60
      $y += ($sy - $sx)/2;
    }

    # 2*(sx,sy) + rot+60(sx,sy)
    ($sx,$sy) = ((5*$sx - 3*$sy) / 2,
                 ($sx + 5*$sy) / 2);
  }
  return ($x,$y);
}

# modulus
#       1   3
#        \ /
#     5---0---2
#        / \
#       4   6
#                       0  1  2  3  4  5  6
my @modulus_to_x     = (0,-1, 2, 1,-1,-2, 1);
my @modulus_to_y     = (0, 1, 0, 1,-1, 0,-1);
my @modulus_to_digit = (0, 3, 1, 2, 5, 4, 6);

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

  $x = round_nearest($x);
  $y = round_nearest($y);
  if (($x + $y) % 2) {
    return undef;
  }

  my $level = _xy_to_level_ceil($x,$y);
  if (is_infinite($level)) {
    return $level;
  }

  my $zero = ($x * 0 * $y);  # inherit bignum 0
  my @n; # digits low to high

  while ($level-- >= 0 && ($x || $y)) {
    ### at: "$x,$y  m=".(($x + 2*$y) % 7)

    my $m = ($x + 2*$y) % 7;
    push @n, $modulus_to_digit[$m];
    $x -= $modulus_to_x[$m];
    $y -= $modulus_to_y[$m];

    ### digit: "to $x,$y"
    ### assert: (3 * $y + 5 * $x) % 14 == 0
    ### assert: (5 * $y - $x) % 14 == 0

    # shrink
    ($x,$y) = ((3*$y + 5*$x) / 14,
               (5*$y - $x) / 14);
  }

  if ($self->{'numbering_type'} eq 'rotate') {
    _digits_unrotate_lowtohigh(\@n);
  }
  return digit_join_lowtohigh (\@n, 7, $zero);
}


# not exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  $y1 *= sqrt(3);
  $y2 *= sqrt(3);
  my ($r_lo, $r_hi) = Math::PlanePath::SacksSpiral::_rect_to_radius_range
    ($x1,$y1, $x2,$y2);
  $r_hi *= 2;
  my $level_plus_1 = ceil( log(max(1,$r_hi/4)) / log(sqrt(7)) ) + 2;
  return (0, 7**$level_plus_1 - 1);
}

sub _xy_to_level_ceil {
  my ($x,$y) = @_;
  my $r = hypot($x,$y);
  $r *= 2;
  return ceil( log(max(1,$r/4)) / log(sqrt(7)) ) + 1;
}

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

sub level_to_n_range {
  my ($self, $level) = @_;
  return (0, 7**$level - 1);
}
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+1, 7);
  return $exp;
}


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