File Coverage

blib/lib/Math/PlanePath/Flowsnake.pm

Criterion	Covered	Total	%
statement	51	119	42.8
branch	9	36	25.0
condition	7	9	77.7
subroutine	10	16	62.5
pod	7	7	100.0
total	84	187	44.9

# Copyright 2010, 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=Flowsnake --lines --scale=10
# math-image --path=Flowsnake --all --output=numbers_dash
# math-image --path=Flowsnake,arms=3 --all --output=numbers_dash
#
# Martin Gardner, "In which `Monster' Curves Force Redefinition of the Word
# `Curve'", Scientific American 235, December 1976, pages 124-133.
#
# http://80386.nl/pub/gosper-level21.png
#
# http://www.mathcurve.com/fractals/gosper/gosper.shtml
#
# plain hexagonal tiling http://tilingsearch.org/HTML/data136/F666.html

# http://complex-systems.com/pdf/24-4-1.pdf
# http://complex-systems.com/issues/24-4.html

# Jeffrey Ventrella
# root-7 family
# "inner-flip" which is initial state reversal



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

use vars '$VERSION', '@ISA';
$VERSION = 128;

# inherit: new(), rect_to_n_range(), arms_count(), n_start(),
#          parameter_info_array(), xy_is_visited()
use Math::PlanePath::FlowsnakeCentres 55; # v.55 inheritance switch-around
@ISA = ('Math::PlanePath::FlowsnakeCentres');
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;

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

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


# (i,j)*(2+w) = (2i-j,2j+i+j) = (2i-j,3j+i)
# (x,y)*(2+w) = 2x + (x-3y)/2, 2y + (x+y)/2
#             = (4x + x-3y)/2, (4y + x+y)/2
#             = (5x-3y)/2, (x+5y)/2

{
  my @x_negative_at_n = (undef, 23, 1, 1);
  sub x_negative_at_n {
    my ($self) = @_;
    return $x_negative_at_n[$self->{'arms'}];
  }
}
{
  my @y_negative_at_n = (undef, 8598, 7, 2);
  sub y_negative_at_n {
    my ($self) = @_;
    return $y_negative_at_n[$self->{'arms'}];
  }
}

{
  my @_UNDOCUMENTED__dxdy_list_at_n = (undef, 11, 6, 9);
  sub _UNDOCUMENTED__dxdy_list_at_n {
    my ($self) = @_;
    return $_UNDOCUMENTED__dxdy_list_at_n[$self->{'arms'}];
  }
}

# Table generated by tools/flowsnake-table.pl.
# next_state length 84
my @next_state = (0, 21,49,28, 0, 0,77, 70, 7, 7,35,42,14, 7,  # 0,7
                  14,35,63,42,14,14, 7,  0,21,21,49,56,28,21,  # 14,21
                  28,49,77,56,28,28,21, 14,35,35,63,70,42,35,  # 28,35
                  42,63, 7,70,42,42,35, 28,49,49,77, 0,56,49,  # 42,49
                  56,77,21, 0,56,56,49, 42,63,63, 7,14,70,63,  # 56,63
                  70, 7,35,14,70,70,63, 56,77,77,21,28, 0,77);  # 70,77
my @digit_to_i = (0,  1, 1, 0,-1, 0, 1,  0, 1, 2, 3, 2, 1, 1,  # 0,7
                  0,  0,-1,-1,-2,-2,-2,  0, 1, 1, 1, 0, 0,-1,  # 14,21
                  0, -1,-2,-1,-1,-2,-3,  0, 0,-1,-2,-2,-1,-2,  # 28,35
                  0, -1,-1, 0, 1, 0,-1,  0,-1,-2,-3,-2,-1,-1,  # 42,49
                  0,  0, 1, 1, 2, 2, 2,  0,-1,-1,-1, 0, 0, 1,  # 56,63
                  0,  1, 2, 1, 1, 2, 3,  0, 0, 1, 2, 2, 1,2);  # 70,77
my @digit_to_j = (0,  0, 1, 1, 2, 2, 2,  0,-1,-1,-1, 0, 0, 1,  # 0,7
                  0,  1, 2, 1, 1, 2, 3,  0, 0, 1, 2, 2, 1, 2,  # 14,21
                  0,  1, 1, 0,-1, 0, 1,  0, 1, 2, 3, 2, 1, 1,  # 28,35
                  0,  0,-1,-1,-2,-2,-2,  0, 1, 1, 1, 0, 0,-1,  # 42,49
                  0, -1,-2,-1,-1,-2,-3,  0, 0,-1,-2,-2,-1,-2,  # 56,63
                  0, -1,-1, 0, 1, 0,-1,  0,-1,-2,-3,-2,-1,-1);  # 70,77

# state 0 to 11
my @dir6_to_di = (1, 0,-1, -1, 0, 1);
my @dir6_to_dj = (0, 1, 1,  0,-1,-1);

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

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

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

  my $state;
  {
    my $arm = _divrem_mutate ($int, $self->{'arms'});
    $state = 28 * $arm;  # initial rotation

    # adjust so that for arms=2 point N=1 has $int==1
    # or for arms=3 then points N=1 and N=2 have $int==1
    if ($arm) { $int += 1; }
  }
  ### initial state: $state

  my $i = my $j = $int*0;  # bignum zero

  foreach my $digit (reverse digit_split_lowtohigh($int,7)) { # high to low
    ### at: "state=$state digit=$digit  i=$i,j=$j  di=".$digit_to_i[$state+$digit]." dj=".$digit_to_j[$state+$digit]

    # (i,j) *= (2+w), being (i,j) = 2*(i,j)+rot60(i,j)
    # then add low digit pos
    #
    $state += $digit;
    ($i, $j) = (2*$i - $j + $digit_to_i[$state],
                3*$j + $i + $digit_to_j[$state]);
    $state = $next_state[$state];
  }
  ### integer: "i=$i, j=$j"

  # fraction in final $state direction
  if ($n) {
    ### apply: "frac=$n  state=$state"
    $state = int($state/14);   # divide to direction 0 to 5
    $i = $n * $dir6_to_di[$state] + $i;
    $j = $n * $dir6_to_dj[$state] + $j;
  }

  ### ret: "$i, $j  x=".(2*$i+$j)." y=$j"
  return (2*$i+$j,
          $j);

}

# Table generated by tools/flowsnake-table.pl.
my @digit_to_next_di
  = (0, -1,-1, 1, 1, 1,undef,  1, 1,-1,-1, 0, 1,undef,  # 0,7
     -1, 0,-1, 0, 0, 1,undef,  0, 0,-1, 0,-1, 0,undef,  # 14,21
     -1, 1, 0,-1,-1, 0,undef, -1,-1, 0, 1,-1,-1,undef,  # 28,35
     0,  1, 1,-1,-1,-1,undef, -1,-1, 1, 1, 0,-1,undef,  # 42,49
     1,  0, 1, 0, 0,-1,undef,  0, 0, 1, 0, 1, 0,undef,  # 56,63
     1, -1, 0, 1, 1, 0,undef,  1, 1, 0,-1, 1, 1,undef,  # 70,77
     1, -1,-1, 1, 1, 0,undef,  1, 1, 0,-1, 0, 1,undef,  # 84,91
     0, -1,-1, 0, 0, 1,undef,  1, 1,-1, 0,-1, 1,undef,  # 98,105
     -1, 0, 0,-1,-1, 1,undef,  0, 0,-1, 1,-1, 0,undef,  # 112,119
     -1, 1, 1,-1,-1, 0,undef, -1,-1, 0, 1, 0,-1,undef,  # 126,133
     0,  1, 1, 0, 0,-1,undef, -1,-1, 1, 0, 1,-1,undef,  # 140,147
     1,  0, 0, 1, 1,-1,undef,  0, 0, 1,-1, 1,0);
my @digit_to_next_dj
  = (1,  0, 1, 0, 0,-1,undef,  0, 0, 1, 0, 1, 0,undef,  # 0,7
     1, -1, 0, 1, 1, 0,undef,  1, 1, 0,-1, 1, 1,undef,  # 14,21
     0, -1,-1, 1, 1, 1,undef,  1, 1,-1,-1, 0, 1,undef,  # 28,35
     -1, 0,-1, 0, 0, 1,undef,  0, 0,-1, 0,-1, 0,undef,  # 42,49
     -1, 1, 0,-1,-1, 0,undef, -1,-1, 0, 1,-1,-1,undef,  # 56,63
     0,  1, 1,-1,-1,-1,undef, -1,-1, 1, 1, 0,-1,undef,  # 70,77
     0,  1, 1, 0, 0,-1,undef, -1,-1, 1, 0, 1,-1,undef,  # 84,91
     1,  0, 0, 1, 1,-1,undef,  0, 0, 1,-1, 1, 0,undef,  # 98,105
     1, -1,-1, 1, 1, 0,undef,  1, 1, 0,-1, 0, 1,undef,  # 112,119
     0, -1,-1, 0, 0, 1,undef,  1, 1,-1, 0,-1, 1,undef,  # 126,133
     -1, 0, 0,-1,-1, 1,undef,  0, 0,-1, 1,-1, 0,undef,  # 140,147
     -1, 1, 1,-1,-1, 0,undef, -1,-1, 0, 1, 0,-1);

sub n_to_dxdy {
  my ($self, $n) = @_;
  ### Flowsnake n_to_dxdy(): $n

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

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

  my $state;
  {
    my $arm = _divrem_mutate ($int, $self->{'arms'});
    $state = 28 * $arm;  # initial rotation

    # adjust so that for arms=2 point N=1 has $int==1
    # or for arms=3 then points N=1 and N=2 have $int==1
    if ($arm) { $int += 1; }
  }
  ### initial state: $state

  my $turn_state = $state;
  my $turn_notlow = 0;
  foreach my $digit (reverse digit_split_lowtohigh($int,7)) { # high to low
    ### $digit
    $state += $digit;

    if ($digit == 6) {
      $turn_notlow = 84;     # is not the least significant digit
    } else {
      $turn_state = $state;  # lowest non-6
      $turn_notlow = 0;      # and is the least significant digit
    }
    $state = $next_state[$state];
  }
  ### int digits state: $state
  ### $turn_state
  ### $turn_notlow

  $state = int($state/14);
  my $di = $dir6_to_di[$state];
  my $dj = $dir6_to_dj[$state];
  ### int direction: "di=$di, dj=$dj"

  # fraction in final $state direction
  if ($n) {
    $turn_state += $turn_notlow;
    my $next_di = $digit_to_next_di[$turn_state];
    my $next_dj = $digit_to_next_dj[$turn_state];

    ### $next_di
    ### $next_dj

    $di += $n*($next_di - $di);
    $dj += $n*($next_dj - $dj);

    ### with frac: "di=$di, dj=$dj"
  }

  ### ret: "dx=".(2*$di+$dj)." dy=$dj"
  return (2*$di+$dj,
          $dj);

}

my @attempt_dx = (0, -2, -1);
my @attempt_dy = (0, 0, -1);
sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### Flowsnake xy_to_n(): "$x, $y"

  $x = round_nearest($x);
  $y = round_nearest($y);
  if (($x + $y) % 2) { return undef; }
  ### round to: "$x,$y"

  my ($n, $cx, $cy);
  foreach my $i (0, 1, 2) {
    if (defined ($n = $self->SUPER::xy_to_n($x + $attempt_dx[$i],
                                            $y + $attempt_dy[$i]))
        && (($cx,$cy) = $self->n_to_xy($n))
        && $x == $cx
        && $y == $cy) {
      return $n;
    }
  }
  return undef;
}

# 0  straight
# 1  +60 rev
# 2  180 rev
# 3  +240
# 4  straight
# 5  straight
# 6  -60 rev

# 4---- 5---- 6
#  \           \
#    3---- 2    7
#        /
# 0---- 1
#
# turn(N) = tdir6(N)-tdir6(N-1)
# N-1 changes low 0s to low 6s
# N   = aaad000
# N-1 = aaac666
# low 0s no change to direction
# low 6s state 7
# N=14=20[7] dir[2]=3,dirrev[0]=5 total 3+5=2mod6
# N-1=13=16[7] dir[1]=1,dirrev[6]=0 total 1+0=1  diff 2-1=1
# dir[2]-dir[1]=2
# dirrev[0] since digit=2 goes to rev
# N=23=32[7]

#            0  1  2  3  4  5
my @turn6 = (1, 2,-1,-2, 0,-1,  # forward
             1, 0, 2, 1,-2,-1,  # reverse
             #
             1, 1,-1,-1, 1,-1,  # 0,0,-1,0,+1,+1,0
             1,-1, 1, 1,-1,-1,  # 0,0,-1,-1,0,+1,0
            );
my @digit_to_reverse = (-1,5,5,undef,-1,-1,5);  # -1=forward,5=reverse
sub _WORKING_BUT_SECRET__n_to_turn6 {
  my ($self, $n) = @_;
  unless ($n >= 1) {
    return undef;
  }
  if (is_infinite($n)) {
    return $n;
  }

  my $lowdigit = _divrem_mutate($n,7);
  ### $lowdigit

  # skip low 0 digits
  unless ($lowdigit) {
    while ($n) {
      last if ($lowdigit = _divrem_mutate($n,7));  # stop at non-zero
    }
    # flag that some zeros were skipped
    $lowdigit += 12;
    ### $lowdigit
  }

  # Forward/reverse reverse from lowest non-3.
  # Digit parts 0,4,5 always forward, 1,2,6 always reverse,
  # 3 is unchanged so following the digit above it.
  for (;;) {
    my $digit = _divrem_mutate($n,7);
    if ($digit != 3) {
      $lowdigit += $digit_to_reverse[$digit];
      last;
    }
  }

  ### lookup: $lowdigit
  return $turn6[$lowdigit];
}

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

#           arms=1       arms=2            arms=3
# level 0  0..1  = 2    0..2  = 2+1=3     0..3   = 2+1+1=4
# level 1  0..7  = 8    0..14 = 8+7=15    0..21  = 8+7+7=22
# level 2  0..49 = 50   0..98 = 50+49=99  0..147 = 50+49+49=148
#          7^k          2*7^k             3*7^k
#
sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  7**$level * $self->{'arms'});
}
sub n_to_level {
  my ($self, $n) = @_;
  ### n_to_level(): $n
  if ($n < 0) { return undef; }
  if (is_infinite($n)) { return $n; }
  $n = round_nearest($n);
  $n += $self->{'arms'}-1;  # division rounding up
  _divrem_mutate ($n, $self->{'arms'});
  my ($pow, $exp) = round_up_pow ($n, 7);
  return $exp;
}

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