# Copyright 2011 Kevin Ryde

# This file is part of Math-Image.
#
# Math-Image 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-Image 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-Image.  If not, see <http://www.gnu.org/licenses/>.


# http://www.springerlink.com/content/y1l60g7125038668/  [pay]
#
# Google Books LATIN'95 link:
# http://books.google.com.au/books?id=_aKhJUJunYwC&lpg=PA36&ots=ARyDkP_hjU&dq=%22Space-Filling%20Curves%20and%20Their%20Use%20in%20the%20Design%20of%20Geometric%20Data%20Structures%22&pg=PA36#v=onepage&q&f=false


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

use vars '$VERSION', '@ISA';
$VERSION = 82;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_is_infinite = \&Math::PlanePath::_is_infinite;
*_round_nearest = \&Math::PlanePath::_round_nearest;

use Math::PlanePath::KochCurve 42;
*_round_down_pow = \&Math::PlanePath::KochCurve::_round_down_pow;

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


use constant n_start => 0;
use constant x_negative => 0;
use constant y_negative => 0;

# tables generated by tools/ar2w2-curve-table.pl
#
my @next_state
  = (224, 84,132,120, 228, 88,136,124, 232, 92,140,112, 236, 80,128,116,
     104,148, 68,240, 108,152, 72,244,  96,156, 76,248, 100,144, 64,252,
      76,164,104,196,  64,168,108,200,  68,172, 96,204,  72,160,100,192,
     212,120,180, 92, 216,124,184, 80, 220,112,188, 84, 208,116,176, 88,
     220,160, 64,100, 208,164, 68,104, 212,168, 72,108, 216,172, 76, 96,
     116, 80,176,204, 120, 84,180,192, 124, 88,184,196, 112, 92,188,200,
      92, 96,128,244,  80,100,132,248,  84,104,136,252,  88,108,140,240,
     228,144,112, 76, 232,148,116, 64, 236,152,120, 68, 224,156,124, 72,
      56, 68, 12,124,  60, 72,  0,112,  48, 76,  4,116,  52, 64,  8,120,
     108, 28, 84, 40,  96, 16, 88, 44, 100, 20, 92, 32, 104, 24, 80, 36,
      84, 32,108, 12,  88, 36, 96,  0,  92, 40,100,  4,  80, 44,104,  8,
      28,124, 48, 68,  16,112, 52, 72,  20,116, 56, 76,  24,120, 60, 64,
     220, 32,172, 44, 208, 36,160, 32, 212, 40,164, 36, 216, 44,168, 40,
      60,188, 48,204,  48,176, 52,192,  52,180, 56,196,  56,184, 60,200,
       0,132, 12,252,   4,136,  0,240,   8,140,  4,244,  12,128,  8,248,
     236, 28,148, 16, 224, 16,152, 20, 228, 20,156, 24, 232, 24,144, 28);
my @digit_to_x
  = (0,1,0,1, 1,1,0,0, 1,0,1,0, 0,0,1,1,
     1,0,1,0, 0,0,1,1, 0,1,0,1, 1,1,0,0,
     0,0,1,1, 1,0,1,0, 1,1,0,0, 0,1,0,1,
     1,1,0,0, 0,1,0,1, 0,0,1,1, 1,0,1,0,
     0,0,1,1, 1,0,0,1, 1,1,0,0, 0,1,1,0,
     1,1,0,0, 1,0,0,1, 0,0,1,1, 0,1,1,0,
     0,0,1,1, 1,0,0,1, 1,1,0,0, 0,1,1,0,
     1,1,0,0, 1,0,0,1, 0,0,1,1, 0,1,1,0,
     0,0,1,1, 1,0,0,1, 1,1,0,0, 0,1,1,0,
     1,1,0,0, 1,0,0,1, 0,0,1,1, 0,1,1,0,
     0,0,1,1, 1,0,0,1, 1,1,0,0, 0,1,1,0,
     1,1,0,0, 1,0,0,1, 0,0,1,1, 0,1,1,0,
     0,0,1,1, 1,0,0,1, 1,1,0,0, 0,1,1,0,
     1,1,0,0, 1,0,0,1, 0,0,1,1, 0,1,1,0,
     0,0,1,1, 1,0,0,1, 1,1,0,0, 0,1,1,0,
     1,1,0,0, 1,0,0,1, 0,0,1,1, 0,1,1,0);
my @digit_to_y
  = (0,0,1,1, 0,1,0,1, 1,1,0,0, 1,0,1,0,
     1,1,0,0, 1,0,1,0, 0,0,1,1, 0,1,0,1,
     0,1,0,1, 0,0,1,1, 1,0,1,0, 1,1,0,0,
     1,0,1,0, 1,1,0,0, 0,1,0,1, 0,0,1,1,
     0,1,1,0, 0,0,1,1, 1,0,0,1, 1,1,0,0,
     0,1,1,0, 1,1,0,0, 1,0,0,1, 0,0,1,1,
     0,1,1,0, 0,0,1,1, 1,0,0,1, 1,1,0,0,
     0,1,1,0, 1,1,0,0, 1,0,0,1, 0,0,1,1,
     0,1,1,0, 0,0,1,1, 1,0,0,1, 1,1,0,0,
     0,1,1,0, 1,1,0,0, 1,0,0,1, 0,0,1,1,
     0,1,1,0, 0,0,1,1, 1,0,0,1, 1,1,0,0,
     0,1,1,0, 1,1,0,0, 1,0,0,1, 0,0,1,1,
     0,1,1,0, 0,0,1,1, 1,0,0,1, 1,1,0,0,
     0,1,1,0, 1,1,0,0, 1,0,0,1, 0,0,1,1,
     0,1,1,0, 0,0,1,1, 1,0,0,1, 1,1,0,0,
     0,1,1,0, 1,1,0,0, 1,0,0,1, 0,0,1,1);
my @yx_to_digit
  = (0,2,1,3, 2,3,0,1, 3,1,2,0, 1,0,3,2,
     3,1,2,0, 1,0,3,2, 0,2,1,3, 2,3,0,1,
     0,1,2,3, 1,3,0,2, 3,2,1,0, 2,0,3,1,
     3,2,1,0, 2,0,3,1, 0,1,2,3, 1,3,0,2,
     0,1,3,2, 1,2,0,3, 2,3,1,0, 3,0,2,1,
     3,2,0,1, 2,1,3,0, 1,0,2,3, 0,3,1,2,
     0,1,3,2, 1,2,0,3, 2,3,1,0, 3,0,2,1,
     3,2,0,1, 2,1,3,0, 1,0,2,3, 0,3,1,2,
     0,1,3,2, 1,2,0,3, 2,3,1,0, 3,0,2,1,
     3,2,0,1, 2,1,3,0, 1,0,2,3, 0,3,1,2,
     0,1,3,2, 1,2,0,3, 2,3,1,0, 3,0,2,1,
     3,2,0,1, 2,1,3,0, 1,0,2,3, 0,3,1,2,
     0,1,3,2, 1,2,0,3, 2,3,1,0, 3,0,2,1,
     3,2,0,1, 2,1,3,0, 1,0,2,3, 0,3,1,2,
     0,1,3,2, 1,2,0,3, 2,3,1,0, 3,0,2,1,
     3,2,0,1, 2,1,3,0, 1,0,2,3, 0,3,1,2);

{
  sub make_state {
    my ($part, $rev, $rot) = @_;

    $rev %= 2;
    $rot %= 4;
    return 4*($rot + 4*($rev + 2*$part));
  }
  sub state_string {
    my ($state) = @_;
    my $digit = $state % 4; $state = int($state/4);
    my $rot   = $state % 4; $state = int($state/4);
    my $rev   = $state % 2; $state = int($state/2);
    my $part  = $state;
    return "part=$part rot=$rot rev=$rev digit=$digit";
}

  use constant A1 => 0;
  use constant A2 => 1;
  use constant B1 => 2;
  use constant B2 => 3;
  use constant C1 => 4;
  use constant C2 => 5;
  use constant D1 => 6;
  use constant D2 => 7;

  foreach my $part (A1, A2, B1, B2, C1, C2, D1, D2) {
    foreach my $rev (0, 1) {
      foreach my $rot (0, 1, 2, 3) {
        foreach my $orig_digit (0, 1, 2, 3) {
          my $digit = $orig_digit;

          if ($rev) {
            $digit = 3-$digit;
          }

          my $xo = 0;
          my $yo = 0;
          my $new_rot = $rot;
          my $new_part = $part;
          my $new_rev = $rev;

          if ($part == A1) {
            if ($digit == 0) {
              $new_part = D2;
            } elsif ($digit == 1) {
              $xo = 1;
              $new_part = B1;
              $new_rot = $rot - 1;
              $new_rev ^= 1;
            } elsif ($digit == 2) {
              $yo = 1;
              $new_rot = $rot + 1;
              $new_part = C1;
            } elsif ($digit == 3) {
              $xo = 1;
              $yo = 1;
              $new_part = B2;
              $new_rot = $rot + 2;
              $new_rev ^= 1;
            }

          } elsif ($part == A2) {
            if ($digit == 0) {
              $new_part = B1;
              $new_rot = $rot - 1;
              $new_rev ^= 1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = C2;
            } elsif ($digit == 2) {
              $xo = 1;
              $new_rot = $rot + 2;
              $new_part = B2;
              $new_rev ^= 1;
            } elsif ($digit == 3) {
              $xo = 1;
              $yo = 1;
              $new_part = D1;
              $new_rot = $rot + 1;
            }

          } elsif ($part == B1) {
            if ($digit == 0) {
              $new_part = D1;
              $new_rot = $rot - 1;
              $new_rev ^= 1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = C2;
            } elsif ($digit == 2) {
              $xo = 1;
              $yo = 1;
              $new_part = B1;
            } elsif ($digit == 3) {
              $xo = 1;
              $new_part = B2;
              $new_rot = $rot + 1;
              $new_rev ^= 1;
            }

          } elsif ($part == B2) {
            if ($digit == 0) {
              $new_part = B1;
              $new_rot = $rot - 1;
              $new_rev ^= 1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = B2;
            } elsif ($digit == 2) {
              $xo = 1;
              $yo = 1;
              $new_part = C1;
            } elsif ($digit == 3) {
              $xo = 1;
              $new_part = D2;
              $new_rot = $rot + 1;
              $new_rev ^= 1;
            }

          } elsif ($part == C1) {
            if ($digit == 0) {
              $new_part = A2;
              $new_rot = $rot + 2;
              $new_rev ^= 1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = B1;
              $new_rot = $rot + 1;
            } elsif ($digit == 2) {
              $xo = 1;
              $yo = 1;
              $new_rot = $rot - 1;
              $new_part = A1;
            } elsif ($digit == 3) {
              $xo = 1;
              $new_part = B2;
              $new_rot = $rot + 1;
              $new_rev ^= 1;
            }

          } elsif ($part == C2) {
            if ($digit == 0) {
              $new_part = B1;
              $new_rot = $rot - 1;
              $new_rev ^= 1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = A2;
            } elsif ($digit == 2) {
              $xo = 1;
              $yo = 1;
              $new_rot = $rot - 1;
              $new_part = B2;
            } elsif ($digit == 3) {
              $xo = 1;
              $new_part = A1;
              $new_rot = $rot - 1;
            }

          } elsif ($part == D1) {
            if ($digit == 0) {
              $new_part = D1;
              $new_rot = $rot - 1;
              $new_rev ^= 1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = A2;
            } elsif ($digit == 2) {
              $xo = 1;
              $yo = 1;
              $new_rot = $rot - 1;
              $new_part = C2;
            } elsif ($digit == 3) {
              $xo = 1;
              $new_part = A2;
              $new_rot = $rot - 1;
            }

          } elsif ($part == D2) {
            if ($digit == 0) {
              $new_part = A1;
            } elsif ($digit == 1) {
              $yo = 1;
              $new_part = C1;
              $new_rot = $rot + 1;
            } elsif ($digit == 2) {
              $xo = 1;
              $yo = 1;
              $new_part = A1;
              $new_rot = $rot - 1;
            } elsif ($digit == 3) {
              $xo = 1;
              $new_part = D2;
              $new_rot = $rot + 1;
              $new_rev ^= 1;
            }

          } else {
            die;
          }

          ### base: "$xo, $yo"

          if ($rot & 2) {
            $xo ^= 1;
            $yo ^= 1;
          }
          if ($rot & 1) {
            ($xo,$yo) = ($yo^1,$xo);
          }
          ### rot to: "$xo, $yo"

          my $state = make_state ($part, $rev, $rot);
          $digit_to_x[$state+$orig_digit] = $xo;
          $digit_to_y[$state+$orig_digit] = $yo;
          $yx_to_digit[$state + $yo*2 + $xo] = $orig_digit;

          my $next_state = make_state
            ($new_part, $new_rev, $new_rot);
          $next_state[$state+$orig_digit] = $next_state;
        }
      }
    }
  }

  if (0) {
    my @pending_state = (make_state(D2,0,0),
                         make_state(A1,0,0));
    my $count = 0;
    my @seen_state;
    my $depth = 1;
    $seen_state[0] = $depth;
    while (@pending_state) {
      my $state = pop @pending_state;
      $count++;
      ### consider state: $state

      foreach my $digit (0 .. 3) {
        my $next_state = $next_state[$state+$digit];
        if (! $seen_state[$next_state]) {
          $seen_state[$next_state] = $depth;
          push @pending_state, $next_state;
          ### push: "$next_state  depth $depth"
        }
      }
      $depth++;
    }
    for (my $state = 0; $state < @next_state; $state += 4) {
      if (! defined $seen_state[$state]) { $seen_state[$state] = 'none'; }
      my $str = state_string($state);
      print "# used state $state   depth $seen_state[$state]    $str\n";
    }
    print "used state count $count\n";
  }
}

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

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

  {
    # ENHANCE-ME: determine dx/dy direction from N bits, not full
    # calculation of N+1
    my $int = int($n);
    if ($n != $int) {
      my $frac = $n - $int;  # inherit possible BigFloat/BigRat
      my ($x1,$y1) = $self->n_to_xy($int);
      my ($x2,$y2) = $self->n_to_xy($int+1);
      my $dx = $x2-$x1;
      my $dy = $y2-$y1;
      return ($frac*$dx + $x1, $frac*$dy + $y1);
    }
    $n = $int;
  }

  my @digits;
  my $len = $n*0 + 1;   # inherit bignum 1
  while ($n || ($#digits&1)) {
    push @digits, $n % 4;
    $n = int($n/4);
    $len *= 2;
  }
  ### digits: join(', ',@digits)."   count ".scalar(@digits)
  ### $len

  my $state = 0;
  my $x = 0;
  my $y = 0;

  while (@digits) {
    $len /= 2;
    $state += pop @digits;

    ### $len
    ### $state
    ### state: state_string($state)
    ### digit_to_x: $digit_to_x[$state]
    ### digit_to_y: $digit_to_y[$state]
    ### next_state: $next_state[$state]

    $x += $len * $digit_to_x[$state];
    $y += $len * $digit_to_y[$state];
    $state = $next_state[$state];
  }

  ### final: "$x,$y"
  return ($x, $y);
}

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

  $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;
  }

  my ($len, $level) = _round_down_pow (($x > $y ? $x : $y),
                                       2);
  ### $len
  ### $level

  my $n = ($x * 0 * $y);  # inherit bignum 0
  my $state = ($level & 1 ? make_state(D2,0,0) : make_state(A1,0,0));
  while ($level-- >= 0) {
    ### at: "$x,$y  len=$len level=$level"
    ### assert: $x >= 0
    ### assert: $y >= 0
    ### assert: $x < 2*$len
    ### assert: $y < 2*$len

    my $xo = int ($x / $len);
    my $yo = int ($y / $len);
    ### assert: $xo >= 0
    ### assert: $xo <= 1
    ### assert: $yo >= 0
    ### assert: $yo <= 1

    $x %= $len;
    $y %= $len;
    ### xy bits: "$xo, $yo"

    my $digit = $yx_to_digit[$state + 2*$yo + $xo];
    $state = $next_state[$state+$digit];
    $n = 4*$n + $digit;
    $len /= 2;
  }

  ### assert: $x == 0
  ### assert: $y == 0

  return $n;
}

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

  $x1 = _round_nearest ($x1);
  $x2 = _round_nearest ($x2);
  ($x1,$x2) = ($x2,$x1) if $x1 > $x2;

  $y1 = _round_nearest ($y1);
  $y2 = _round_nearest ($y2);
  ($y1,$y2) = ($y2,$y1) if $y1 > $y2;

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

  my ($len, $level) = _round_down_pow (($x2 > $y2 ? $x2 : $y2),
                                       2);
  ### $len
  ### $level
  return (0, 4*$len*$len-1);
}

1;
__END__

=for stopwords eg Ryde ie AR2W2Curve Math-PlanePath Asano Ranjan Roos Welzl Widmayer HilbertCurve ZOrderCurve Informatics

=head1 NAME

Math::PlanePath::MathImageAR2W2Curve -- 2x2 self-similar of four pattern parts

=head1 SYNOPSIS

 use Math::PlanePath::MathImageAR2W2Curve;
 my $path = Math::PlanePath::MathImageAR2W2Curve->new;
 my ($x, $y) = $path->n_to_xy (123);

=head1 DESCRIPTION

I<In progress ...>

This is an integer version of the AR2W2 curve by Asano, Ranjan, Roos, Welzl
and Widmayer.

                                         | 
      7     42--43--44  47--48--49  62--63   
              \      |   |       |   |     
      6     40--41  45--46  51--50  61--60 
             |               |           | 
      5     39  36--35--34  52  55--56  59 
             |   |    /      |   |   |   | 
      4     38--37  33--32  53--54  57--58 
                          \                
      3      6-- 7-- 8  10  31  28--27--26 
             |       |/  |   |   |       | 
      2      5-- 4   9  11  30--29  24--25 
                 |       |           |     
      1      2-- 3  13--12  17--18  23--22 
              \      |       |   |       | 
    Y=0 ->   0-- 1  14--15--16  19--20--21 
          
            X=0  1   2   3   4   5   6   7 

It makes a 2x2 expanding pattern with a mixture of "U" and "Z" shapes.  The
mixture is designed to improve some locality measures.

There's four base patterns A to D, plus mirroring,

    A1    C1---B2        A2   C2   D1
             \                 | \  |
          D2---B1             B1   B2

    B1    C2---B1        B2   B2---C1
           |    |              |    |
          D1   B2             B1   D2

    C1    B1---A1        C2   A2---B2
           |    |              |    |
          A2   B2             B1   A1

    D1    A2---C2        D2   C1---A1
           |    |              |    |
          D1   A2             A1   D2

The starting pattern is the A1 "Z" shape and above that D2.  Notice the
starting sub-part of D2 is A1 and in turn the starting sub-part of A1 is D2,
so those two alternate at progressively higher levels.  The sub-parts of the
two then reach all of the others, in transpose and straight forms, forward
and reverse, and rotated four directions.

=head1 FUNCTIONS

See L<Math::PlanePath/FUNCTIONS> for the behaviour common to all path
classes.

=over 4

=item C<$path = Math::PlanePath::MathImageAR2W2Curve-E<gt>new ()>

Create and return a new path object.

=item C<($x,$y) = $path-E<gt>n_to_xy ($n)>

Return the X,Y coordinates of point number C<$n> on the path.  Points begin
at 0 and if C<$n E<lt> 0> then the return is an empty list.

=back

=head1 SEE ALSO

L<Math::PlanePath>,
L<Math::PlanePath::HilbertCurve>,
L<Math::PlanePath::ZOrderCurve>

Asano, Ranjan, Roos, Welzl and Widmayer "Space-Filling Curves and Their Use
in the Design of Geometric Data Structures", Theoretical Computer Science,
181(1):3-15, 1997.  And LATIN'95 Theoretical Informatics which is at Google
Books

    http://books.google.com/books?isbn=3540591753

=cut


# Local variables:
# compile-command: "math-image --path=MathImageAR2W2Curve --lines --scale=20"
# End:
#
# math-image --path=MathImageAR2W2Curve --all --output=numbers_dash
