The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2017 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/>.

use 5.004;
use strict;
use Test;
plan tests => 35;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }

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

require Math::PlanePath::QuintetReplicate;


#------------------------------------------------------------------------------
# VERSION

{
  my $want_version = 125;
  ok ($Math::PlanePath::QuintetReplicate::VERSION, $want_version,
      'VERSION variable');
  ok (Math::PlanePath::QuintetReplicate->VERSION,  $want_version,
      'VERSION class method');

  ok (eval { Math::PlanePath::QuintetReplicate->VERSION($want_version); 1 },
      1,
      "VERSION class check $want_version");
  my $check_version = $want_version + 1000;
  ok (! eval { Math::PlanePath::QuintetReplicate->VERSION($check_version); 1 },
      1,
      "VERSION class check $check_version");

  my $path = Math::PlanePath::QuintetReplicate->new;
  ok ($path->VERSION,  $want_version, 'VERSION object method');

  ok (eval { $path->VERSION($want_version); 1 },
      1,
      "VERSION object check $want_version");
  ok (! eval { $path->VERSION($check_version); 1 },
      1,
      "VERSION object check $check_version");
}

#------------------------------------------------------------------------------
# n_start, x_negative, y_negative

{
  my $path = Math::PlanePath::QuintetReplicate->new;
  ok ($path->n_start, 0, 'n_start()');
  ok ($path->x_negative, 1, 'x_negative()');
  ok ($path->y_negative, 1, 'y_negative()');
}


#------------------------------------------------------------------------------
# _digits_rotate_lowtohigh()
# _digits_unrotate_lowtohigh()

sub add_to_digit {
  my ($digit, $add) = @_;
  if ($digit) {
    $digit = ((($digit-1) + $add) % 4) + 1;
  }
  return $digit;
}
sub digits_rotate_lowtohigh_by_successive {
  my ($aref) = @_;
  my @new = @$aref;
  foreach my $i (0 .. $#$aref) {
    if ($aref->[$i]) {
      foreach my $j (0 .. $i-1) {   # below $i
        $new[$j] = add_to_digit($new[$j], $aref->[$i] - 1);
      }
    }
  }
  @$aref = @new;
}

{
  foreach my $elem (
                    [ [], [] ],
                    [ [0], [0] ],
                    [ [1], [1] ],
                    [ [4], [4] ],
                    [ [0,1], [0,1] ],
                    [ [4,1], [4,1] ],
                    [ [1,2], [2,2] ],
                    [ [3,3], [1,3] ],
                    [ [1,1,2], [2,2,2] ],
                    [ [1,1,3], [3,3,3] ],
                    [ [2,1,3], [4,3,3] ],
                   ) {
    my ($digits, $rotated) = @$elem;
    {
      my @got = @$digits;
      Math::PlanePath::QuintetReplicate::_digits_rotate_lowtohigh(\@got);
      ok(join(',',@got),join(',',@$rotated),
         "_digits_rotate_lowtohigh of ".join(',',@$digits));
    }
    {
      my @got = @$rotated;
      Math::PlanePath::QuintetReplicate::_digits_unrotate_lowtohigh(\@got);
      ok(join(',',@got),join(',',@$digits),
         "_digits_unrotate_lowtohigh of ".join(',',@$rotated));
    }
  }
}

{
  # rotate / unrotate reversible
  my $bad = 0;
  foreach my $n (0 .. 125) {
    my @digits = Math::PlanePath::Base::Digits::digit_split_lowtohigh($n,5);
    my $digits = join(',',reverse @digits);

    my @rot = @digits;
    Math::PlanePath::QuintetReplicate::_digits_rotate_lowtohigh(\@rot);
    my $rot    = join(',',reverse @rot);

    my @rot_by_successive = @digits;
    digits_rotate_lowtohigh_by_successive(\@rot_by_successive);
    my $rot_by_successive = join(',',reverse @rot_by_successive);
    unless ($rot eq $rot_by_successive) {
      MyTestHelpers::diag("n=$n digits=$digits rot=$rot rot_by_successive=$rot_by_successive");
      if (++$bad >= 5) { last; }
    }

    my @unrot_again = @rot;
    Math::PlanePath::QuintetReplicate::_digits_unrotate_lowtohigh(\@unrot_again);
    my $unrot_again = join(',',reverse @unrot_again);

    if ($digits ne $unrot_again) {
      MyTestHelpers::diag("n=$n digits=$digits rot=$rot unrot_again=$unrot_again");
      if (++$bad >= 1) { last; }
    }
  }
  ok ($bad, 0);
}


#------------------------------------------------------------------------------
# Boundary Squares when Rotate

sub to_base5 {
  my ($n,$k) = @_;
  my @digits = Math::PlanePath::Base::Digits::digit_split_lowtohigh($n,5);
  if (defined $k) {
    while (@digits < $k) { unshift @digits, 0; }
  }
  return join('',@digits);
}

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

foreach my $numbering_type ('fixed','rotate') {
  my $path = Math::PlanePath::QuintetReplicate->new
    (numbering_type => $numbering_type);
  my $bad = 0;
 LEVEL: foreach my $level (3,
                          # 0 .. 5
                          ) {
    my ($n_lo, $n_hi) = $path->level_to_n_range($level);
    my $Bpred_by_path = sub {
      my ($n) = @_;
      my ($x,$y) = $path->n_to_xy($n);
      foreach my $dir4 (0 .. 3) {
        my $n2 = $path->xy_to_n ($x+$dir4_to_dx[$dir4],
                                 $y+$dir4_to_dy[$dir4]);
        if ($n2 > $n_hi) { return 1; }
      }
      return 0;
    };
    foreach my $n ($n_lo .. $n_hi) {
      my $by_path   = $Bpred_by_path->($n) ? 1 : 0;
      my $by_undoc  = $path->_UNDOCUMENTED__n_is_boundary_level($n,$level)
        ? 1 : 0;

      if ($by_path != $by_undoc) {
        my ($x,$y) = $path->n_to_xy($n);
        my $n5 = to_base5($n,$level);
        MyTestHelpers::diag("$numbering_type level=$level n=$n [$n5] $x,$y path $by_path undoc $by_undoc   ($n_lo to $n_hi)");
        if (++$bad >= 1) { last LEVEL; }
      }
    }
  }
  ok ($bad, 0);
}
exit;


      # if ($by_path != $by_digits || $by_path != $by_undoc) {
      #   my ($x,$y) = $path->n_to_xy($n);
      #   my $n5 = to_base5($n,$level);
      #   MyTestHelpers::diag("level=$level n=$n [$n5] $x,$y path $by_path digits $by_digits undoc $by_undoc   ($n_lo to $n_hi)");
      #   if (++$bad >= 10) { last K; }
      # }
      # my $by_digits = $Bpred_by_digits->($n) ? 1 : 0;
    # my $Bpred_by_digits = sub {
    #   my ($n) = @_;
    #   my @digits = reverse    # high to low
    #     Math::PlanePath::Base::Digits::digit_split_lowtohigh($n,5);
    #   while (@digits < $level) { unshift @digits, 0; }
    #   foreach my $digit (@digits) {
    #     if ($digit == 0) { return 0; }
    #   }
    #   shift @digits;  # skip high
    #   @digits = grep {$_!=1} @digits;  # ignore 1s
    #   foreach my $i (0 .. $#digits-1) {
    #     if (($digits[$i] == 3 && $digits[$i+1] == 2)
    #         || ($digits[$i] == 3 && $digits[$i+1] == 3)
    #         || ($digits[$i] == 4 && $digits[$i+1] == 4)) {
    #       return 0;
    #     }
    #   }
    #   return 1;
    # };

#------------------------------------------------------------------------------
# digit rotation per the POD

foreach my $numbering_type ('fixed','rotate') {
  my $path = Math::PlanePath::QuintetReplicate->new
    (numbering_type => $numbering_type);
  my $bad = 0;
  my $k = 3;
  my $pow = 5**$k;
  foreach my $turn (0 .. 3) {
    foreach my $n (0 .. $pow-1) {
      my ($x,$y) = $path->n_to_xy($n);
      my ($tx,$ty) = ($x,$y);
      foreach (1 .. $turn) { ($tx,$ty) = xy_rotate_plus90($tx,$ty); }
      my $txy = "$tx,$ty";
      my $an = digits_add($n,$turn, $numbering_type);
      my ($ax,$ay) = $path->n_to_xy($an);
      my $axy = "$ax,$ay";
      if ($txy ne $axy) {
        my $n5 = join('',reverse Math::PlanePath::Base::Digits::digit_split_lowtohigh($n,5));
        my $an5 = join('',reverse Math::PlanePath::Base::Digits::digit_split_lowtohigh($an,5));
        print "$numbering_type turn=$turn oops, n=$n [$n5] $x,$y turned $txy cf an=$an [$an5] $axy\n";
        $bad++;
      }
    }
  }
  ok ($bad, 0);
}

sub xy_rotate_plus90 {
  my ($x,$y) = @_;
  return (-$y,$x);  # rotate +90
}

sub digits_add {
  my ($n,$offset, $numbering_type) = @_;
  my @digits = Math::PlanePath::Base::Digits::digit_split_lowtohigh($n,5);
  foreach my $digit (reverse @digits) {
    if ($digit) {
      $digit = (($digit-1 + $offset)%4) + 1;  # mutate @digits
    }
    if ($numbering_type eq 'rotate') { last; }
  }
  return Math::PlanePath::Base::Digits::digit_join_lowtohigh (\@digits, 5);
}

#------------------------------------------------------------------------------
# numbering_type => 'rotate' sub-parts rotation

{
  my $path = Math::PlanePath::QuintetReplicate->new (numbering_type=>'rotate');
  my $bad = 0;
  my $k = 3;
  my $pow = 5**$k;
  foreach my $n ($pow .. 2*$pow-1) {
    my ($x,$y) = $path->n_to_xy($n);
    {
      my ($rx,$ry) = $path->n_to_xy($n+$pow);
      ($rx,$ry) = xy_rotate_minus90($rx,$ry);
      my $got = "$rx,$ry";
      my $want = "$x,$y";
      if ($got ne $want) {
        print "oops, got $got want $want\n";
        $bad++;
      }
    }
    {
      my ($rx,$ry) = $path->n_to_xy($n+2*$pow);
      ($rx,$ry) = (-$rx,-$ry);    # rotate 180
      $bad += ("$rx,$ry" ne "$x,$y");
    }
  }
  ok ($bad, 0);
}

sub xy_rotate_minus90 {
  my ($x,$y) = @_;
  return ($y,-$x);  # rotate -90
}

#------------------------------------------------------------------------------
exit 0;