The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright 2016 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 <http://www.gnu.org/licenses/>.


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

use vars '$VERSION', '@ISA';
$VERSION = 124;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;

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

use Math::PlanePath::PeanoCurve;

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


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

use constant parameter_info_array =>
  [ { name      => 'k',
      display   => 'K',
      type      => 'integer',
      minimum   => 3,
      default   => 5,
      width     => 3,
      page_increment => 10,
      step_increment => 2,
    } ];

# ../../../squarecurve.pl
# ../../../run.pl

my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);

sub new {
  my $self = shift->SUPER::new(@_);
  $self->{'k'} ||= 5;

  my $k = $self->{'k'} | 1;
  my $turns = $k >> 1;
  my $square = $k*$k;
  my @digit_to_x;
  my @digit_to_y;
  $self->{'digit_to_x'} = \@digit_to_x;
  $self->{'digit_to_y'} = \@digit_to_y;
  my @digit_to_dir;
  {
    my $x = 0;
    my $y = 0;
    my $dx = 0;
    my $dy = 1;
    my $dir = 1;
    my $n = 0;
    my $run = sub {
      my ($r) = @_;
      foreach my $i (1 .. $r) {
        $digit_to_x[$n] = $x;
        $digit_to_y[$n] = $y;
        $digit_to_dir[$n] = $dir & 3;
        $n++;
        $x += $dx;
        $y += $dy;
      }
    };
    my $spiral = sub {
      while (@_) {
        my $r = shift;
        $run->($r || 1);
        ($dx,$dy) = ($dy,-$dx); # rotate -90
        $dir--;
        last if $r == 0;
      }
      $dx = -$dx;
      $dy = -$dy;
      $dir += 2;
      while (@_) {
        my $r = shift;
        $run->($r);
        ($dx,$dy) = (-$dy,$dx); # rotate +90
        $dir++;
      }
    };
    # 7,9,  3,4
    my $first = (($turns-1) & 2);
    $spiral->(reverse(0 .. $turns),
              1 .. $turns-1,
              ($first
               ? ($turns-1)
               : ($turns, $turns-1)));

    ($dx,$dy) = (-$dx,-$dy); # rotate 180
    $dir += 2;
    if ($first) {
      $spiral->(0,1);
    }

    $spiral->(($first ? ($turns) : ()),
              reverse(0 .. $turns),
              1 .. $turns-1,
              $turns-2);

    ($dx,$dy) = (-$dx,-$dy); # rotate 180
    $dir += 2;

    $spiral->(reverse(0 .. $turns),
              1 .. $turns-2,
              ($first
               ? ($turns-1)
               : ($turns-2)));

    if ($first) {
    } else {
      ($dx,$dy) = (-$dx,-$dy); # rotate 180
      $dir += 2;
      $spiral->(0,1);
    }

    $spiral->(($first ? $turns-2 : $turns-1),
              reverse(0 .. $turns-1),
              1 .. $turns);
  }

  my @next_state;
  my @digit_to_sx;
  my @digit_to_sy;
  $self->{'next_state'} = \@next_state;
  $self->{'digit_to_sx'} = \@digit_to_sx;
  $self->{'digit_to_sy'} = \@digit_to_sy;
  my %xy_to_n;

  my $more = 1;
  while ($more) {
    $more = 0;
    my %xy_to_n_list;
    $more = 0;
    foreach my $n (0 .. $k*$k-1) {
      next if defined $digit_to_sx[$n];
      my $dir = $digit_to_dir[$n];
      my $x = $digit_to_x[$n];
      my $y = $digit_to_y[$n];
      my $dx = $dir4_to_dx[$dir];
      my $dy = $dir4_to_dy[$dir];
      my ($lx,$ly) = (-$dy,$dx); # rotate +90
      my $count = 0;
      my ($sx,$sy,$snext);
      foreach my $right (0, 4) {
        my $next_state = $dir ^ $right;
        my $cx = (2*$x + $dx + $lx - 1)/2;
        my $cy = (2*$y + $dy + $ly - 1)/2;
        ### consider: "$n right=$right is $cx,$cy"
        if ($cx >= 0 && $cy >= 0 && $cx < $k && $cy < $k) {
          push @{$xy_to_n_list{"$cx,$cy"}}, $n, $next_state;
          $count++;
          ($sx,$sy) = ($cx,$cy);
          $snext = $next_state;
        }
        ($lx,$ly) = (-$lx,-$ly);
      }
      if ($count==1) {
        die if defined $digit_to_sx[$n];
        ### store one side: "$n at $sx,$sy  next state $snext"
        $digit_to_sx[$n] = $sx;
        $digit_to_sy[$n] = $sy;
        $next_state[$n] = $snext;
        $more = 1;
        my $sxy = "$sx,$sy";
        if (defined $xy_to_n{$sxy} && $xy_to_n{$sxy} != $n) {
          die "already $xy_to_n{$sxy}";
        }
        $xy_to_n{$sxy} = $n;
      }
    }
    while (my ($cxy,$n_list) = each %xy_to_n_list) {
      ### cxy: "$cxy ".join(',',@$n_list)
      if (@$n_list == 2) {
        my $n = $n_list->[0];
        my ($sx,$sy) = split /,/, $cxy;
        my $sxy = "$sx,$sy";
        if (defined $xy_to_n{$sxy} && $xy_to_n{$sxy} != $n) {
          ### already $xy_to_n{$sxy}
          next;
        }
        $xy_to_n{$sxy} = $n;
        $digit_to_sx[$n] = $sx;
        $digit_to_sy[$n] = $sy;
        $next_state[$n] = $n_list->[1];
        $more = 1;
        ### store one choice: "$n at $sx,$sy  next state $next_state[$n]"
      }
    }
  }

  ### sx        : join(',',@digit_to_sx)
  ### sy        : join(',',@digit_to_sy)
  ### next state: join(',',@next_state)
  return $self;
}

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

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


  my $int = int($n);
  $n -= $int;
  my $k = $self->{'k'} | 1;
  my $square = $k*$k;
  if ($n >= $square**3) { return; }

  my @digits = digit_split_lowtohigh($int,$square);
  while (@digits < 1) {
    push @digits, 0;
  }

  my $digit_to_sx = $self->{'digit_to_sx'};
  my $digit_to_sy = $self->{'digit_to_sy'};
  my $next_state = $self->{'next_state'};

  my @x;
  my @y;
  my $dir = 1;
  my $right = 4;
  my $fracdir = 1;
  foreach my $i (reverse 0 .. $#digits) {  # high to low
    my $digit = $digits[$i];
    ### at: "dir=$dir right=$right  digit=$digit"

    if ($digit != $square-1) {   # lowest non-24 digit
      $fracdir = $dir;
    }

    if ($right) {
      $digit = $square-1-$digit;
      ### reverse: "digit=$digit"
    }
    my $x = $digit_to_sx->[$digit];
    my $y = $digit_to_sy->[$digit];
    ### sxy: "$x,$y"
    # if ($right) {
    #   $x = $k-1-$x;
    #   $y = $k-1-$y;
    # }
    if (($dir ^ ($right>>1)) & 2) {
      $x = $k-1-$x;
      $y = $k-1-$y;
    }
    if ($dir & 1) {
      ($x,$y) = ($k-1-$y, $x);
    }
    ### rotate to: "$x,$y"
    $x[$i] = $x;
    $y[$i] = $y;

    my $next = $next_state->[$digit];
    # if ($right) {
    # } else {
    #   $dir += $next & 3;
    # }
    $dir += $next & 3;
    $right ^= $next & 4;
  }
  ### final: "dir=$dir right=$right"

  ### @x
  ### @y
  ### frac: $n
  my $zero = $int * 0;
  return ($n * 0 # ($digit_to_sx->[$dirstate+1] - $digit_to_sx->[$dirstate])
          + digit_join_lowtohigh(\@x, $k, $zero),

          $n * 0 # ($digit_to_sy->[$dirstate+1] - $digit_to_sy->[$dirstate])
          + digit_join_lowtohigh(\@y, $k, $zero));




  {
    my $digit_to_x = $self->{'digit_to_x'};
    if ($n > $#$digit_to_x) {
      return;
    }
    return ($self->{'digit_to_sx'}->[$n],
            $self->{'digit_to_sy'}->[$n]);

  }

  my $turns = $k >> 1;
  my $t1 = $turns + 1;
  my $rot = -$turns;
  my $x = 0;
  my $y = 0;
  my $qx = 0;
  my $qy = 0;

  my $midpoint = $turns*$t1/2 + 1;
  if (($n -= $midpoint) >= 0) {
    ### after middle ...
    return;
  } else {
    # $qx += $dir4_to_dx[(0*$turns+1)&3];
    # $qy += $dir4_to_dy[(0*$turns+1)&3];
    # $qx -= $dir4_to_dy[($turns+2)&3];
    # $qy += $dir4_to_dx[($turns+2)&3];
    # $qy += 1;
    # $x -= 1;
    if ($n += 1) {
      ### before middle ...
      $n = -$n;
      $rot += 2;
      # $y -= 1;
      # $x -= 1;
    } else {
      ### centre segment ...
      $rot += 1;
      # $qy -= $dir4_to_dx[(-$turns)&3];
    }
  }
  ### key n: $n


  my $q = ($turns*$turns-1)/4;
  ### $q

  # d: [ 0, 1,  2 ]
  # n: [ 0, 3, 10 ]
  # d = -1/4 + sqrt(1/2 * $n + 1/16)
  #   = (-1 + sqrt(8*$n + 1)) / 4
  # N = (2*$d + 1)*$d
  # rel = (2*$d + 1)*$d + 2*$d+1
  #     = (2*$d + 3)*$d + 1
  #
  my $d = int( (_sqrtint(8*$n+1) - 1)/4 );
  $n -= (2*$d+3)*$d + 1;
  ### $d
  ### key signed rem: $n

  if ($n < 0) {
    ### key horizontal ...
    $x += $n+$d + 1;
    $y += -$d;
    if ($d % 2) {
      ### key top ...
      $rot += 2;
      $y -= 1;
    } else {
      ### key bottom ...
    }
  } else {
    ### key vertical ...
    $x += -$d - 1;
    $y += $d - $n;
    $rot += 2;
    if ($d % 2) {
      ### key right ...
      $rot += 2;
      $y += 1;
    } else {
      ### key left ...
    }
  }
  ### kxy raw: "$x, $y"



  if ($rot & 2) {
    $x = -$x;
    $y = -$y;
  }
  if ($rot & 1) {
    ($x,$y) = ($y,-$x);
  }
  ### kxy rotated: "$x,$y"

  # if ($k%8==1 && !$before) {
  #   $y += 1;
  # }
  # if ($k%8==3 && !$before) {
  #   $x += 1;
  # }
  # if ($k%8==5 && $before) {
  #   $y += 1;
  # }
  # if ($k%8==7 && $before) {
  #   $x += 1;
  # }

  $x += $qx;
  $y += $qy;
  return ($x,$y);













  # my $q = ($k*$k-1)/4;
  ### $k
  ### $q
  ### $turns

  # if ($n > $q/2) { return (0,0); }

  my $before;

  # $qx += ($k >> 2);
  # $qy += ($k >> 2);

  if ($n > $q/2) {
    return;
  }
  if ($n >= $q+$turns) {
    $n -= $q+$turns;
    $qx += 1;
    $qy += ($k >> 1) + 1;
  }
  if ($n >= $q+$turns-2) {
    $n -= $q+$turns-2;
    $qx += ($k >> 1) + 10;
    $qy += 1;
    $rot++;
  }

  # $x -= $dir4_to_dx[$rot&3];
  # $y += $dir4_to_dy[$rot&3];

}

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

  return undef;

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

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

}

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

  return (0, 25**3);


  $x1 = round_nearest ($x1);
  $y1 = round_nearest ($y1);
  $x2 = round_nearest ($x2);
  $y2 = round_nearest ($y2);
  ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
  ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
  ### rect_to_n_range(): "$x1,$y1 to $x2,$y2"

  if ($x2 < 0 || $y2 < 0) {
    return (1, 0);
  }

  my $radix = $self->{'k'};

  my ($power, $level) = round_down_pow (max($x2,$y2), $radix);
  if (is_infinite($level)) {
    return (0, $level);
  }
  return (0, $radix*$radix*$power*$power - 1);
}

1;
__END__


# https://books.google.com.au/books?id=-4W_5ZISxpsC&pg=PA49