# 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 = 81;
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" parts in the style of
HilbertCurve and "Z" parts in the style of ZOrderCurve.  The mixture is
designed to improve some kinds of 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::PeanoCurve>

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 on Google Books
books.google.com.au/books?isbn=3540591753.

=cut


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