File Coverage

blib/lib/Math/PlanePath/ZOrderCurve.pm

Criterion	Covered	Total	%
statement	92	160	57.5
branch	12	50	24.0
condition	8	13	61.5
subroutine	19	26	73.0
pod	9	9	100.0
total	140	258	54.2

# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 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=ZOrderCurve,radix=3 --all --output=numbers
# math-image --path=ZOrderCurve --values=Fibbinary --text
#
# increment N+1 changes low 1111 to 10000
# X bits change 011 to 000, no carry, decreasing by number of low 1s
# Y bits change 011 to 100, plain +1
#
# cf A105186 replace odd position ternary digits with 0
#


package Math::PlanePath::ZOrderCurve;
use 5.004;
use strict;
use List::Util 'max';

use vars '$VERSION', '@ISA';
$VERSION = 127;
use Math::PlanePath;
@ISA = ('Math::PlanePath');

use Math::PlanePath::Base::Generic
  'is_infinite',
  'round_nearest';
use Math::PlanePath::Base::Digits
  'parameter_info_array',
  'round_up_pow',
  'digit_split_lowtohigh',
  'digit_join_lowtohigh';
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;

# 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;
*xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;

use constant dx_maximum => 1;
use constant dy_maximum => 1;
use constant absdx_minimum => 1;   # X coord always changes
use constant dsumxy_maximum => 1; # forward straight only

sub dir_maximum_dxdy {
  my ($self) = @_;
  return (1, 1 - $self->{'radix'});  # SE diagonal
}

sub turn_any_straight {
  my ($self) = @_;
  return ($self->{'radix'} != 2);  # radix=2 never straight
}
sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  return $self->{'radix'} - 1;
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  return $self->{'radix'};
}


#------------------------------------------------------------------------------

sub new {
  my $self = shift->SUPER::new(@_);

  my $radix = $self->{'radix'};
  if (! defined $radix || $radix <= 2) { $radix = 2; }
  $self->{'radix'} = $radix;

  return $self;
}

sub n_to_xy {
  my ($self, $n) = @_;
  ### ZOrderCurve n_to_xy(): $n
  if ($n < 0) {
    return;
  }
  if (is_infinite($n)) {
    return ($n,$n);
  }

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

  my $radix = $self->{'radix'};
  my @ndigits = digit_split_lowtohigh ($int, $radix);
  ### @ndigits
  unless ($#ndigits & 1) {
    push @ndigits, 0;  # pad @ndigits to an even number of digits
  }

  my @xdigits;
  my @ydigits;
  while (@ndigits) {
    push @xdigits, shift @ndigits;  # low to high
    push @ydigits, shift @ndigits;  # low to high
  }
  ### @xdigits
  ### @ydigits

  my $zero = ($int * 0); # inherit bigint 0
  my $x = digit_join_lowtohigh (\@xdigits, $radix, $zero);
  my $y = digit_join_lowtohigh (\@ydigits, $radix, $zero);

  if ($n) {
    # fraction part
    my $dx = 1;
    my $dy = $zero;
    my $radix_minus_1 = $radix - 1;
    foreach my $i (0 .. $#xdigits) {  # low to high
      if ($xdigits[$i] != $radix_minus_1) {
        ### lowest non-9 is an X digit, so dx=1 dy=0,-R+1,-R^2+1,etc
        last;
      }
      $dy = ($dy * $radix) - $radix_minus_1;  # 1-$radix**$i
      if ($ydigits[$i] != $radix_minus_1) {
        ### lowest non-9 is a Y digit, so dy=1, dx=-R+1,-R^2+1,etc
        $dx = $dy;
        $dy = 1;
        last;
      }
    }
    ### $dx
    ### $dy
    $x = $n*$dx + $x;
    $y = $n*$dy + $y;
  }

  return ($x, $y);
}

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

  if ($n < 0) {
    return;
  }

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

  if (is_infinite($int)) {
    return ($int,$int);
  }

  my $radix = $self->{'radix'};
  my $digit = _divrem_mutate($int,$radix);   # lowest digit of N
  if ($digit < $radix - 2) {
    # N an integer at lowdigit
    return (1, 0);
  }

  my $radix_minus_1 = $radix - 1;
  my $scan_for_dx = ($digit == $radix_minus_1);
  unless ($scan_for_dx) {
    ### assert: $digit == $radix-2
    unless ($n) {
      # N an integer with lowdigit==radix-2, so dx=1,dy=0
      return (1, 0);
    }
    # scan digits for next_dx,next_dy
  }

  my $power = $radix + ($int*0);  # $radix**$i, inherit bigint

  for (;;) {
    if (_divrem_mutate($int,$radix) != $radix_minus_1) {
      ### lowest non-9 is a Y digit, so dy=1, dx=-R+1,-R^2+1,etc
      if ($scan_for_dx) {
        # scanned for dx=1-power,dy=1 have nextdx=1,nextdy=0
        # frac*(nextdx-dx) + dx = n*(1-(1-power))+(1-power)
        #                       = n*(1-1+power))+1-power
        #                       = n*power+1-power
        #                       = (n-1)*power+1
        # frac*(nextdy-dy) + dy = n*(0-1) + 1
        #                       = 1-n
        return (($n-1)*$power + 1,
                1-$n);

      } else {
        # scanned for nextdx=1-power,nextdy=1 have dx=1,dy=0
        # frac*(nextdx-dx) + dx = n*((1-power)-1)+1
        #                       = n*(1-power-1)+1
        #                       = n*-power+1
        #                       = 1 - n*power
        # frac*(nextdy-dy) + dy = n*(1-0) + 0
        #                       = n
        return (1 - $n*$power,
                $n);
      }
    }

    if (_divrem_mutate($int,$radix) != $radix_minus_1) {
      ### lowest non-9 is an X digit, so dx=1 dy=0,-R+1,-R^2+1,etc
      $power -= 1;
      if ($scan_for_dx) {
        # scanned for dx=1,dy=1-power have nextdx=1,nextdy=0
        # frac*(nextdx-dx) + dx = n*(1-1)+1
        #                       = 1
        # frac*(nextdy-dy) + dy = n*(0-(1-power)) + (1-power)
        #                       = n*(-1+power) + 1-power
        #                       = -n + n*power + 1 - power
        #                       = 1-n + (n-1)*power
        #                       = (n-1)*(power-1)
        return (1,
                ($n-1) * $power);
      } else {
        # scanned for nextdx=1,nextdy=1-power have dx=1,dy=0
        # frac*(nextdx-dx) + dx = n*(1-1) + 1
        #                       = 1
        # frac*(nextdy-dy) + dy = n*((1-power) - 0) + 0
        #                       = n*(1-power)
        return (1,
                -$n*$power);
      }
    }

    $power *= $radix;
  }
}

sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### ZOrderCurve 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 $radix = $self->{'radix'};
  my $zero = ($x * 0 * $y); # inherit bigint 0

  my @x = digit_split_lowtohigh($x,$radix);
  my @y = digit_split_lowtohigh($y,$radix);
  return digit_join_lowtohigh ([ _digit_interleave (\@x, \@y) ],
                               $radix,
                               $zero);
}

# return list of @$xaref interleaved with @$yaref
# ($xaref->[0], $yaref->[0], $xaref->[1], $yaref->[1], ...)
#
sub _digit_interleave {
  my ($xaref, $yaref) = @_;
  my @ret;
  foreach my $i (0 .. max($#$xaref,$#$yaref)) {
    push @ret, $xaref->[$i] || 0;
    push @ret, $yaref->[$i] || 0;
  }
  return @ret;
}

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

  $x1 = round_nearest ($x1);
  $y1 = round_nearest ($y1);
  $x2 = round_nearest ($x2);
  $y2 = round_nearest ($y2);

  if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }  # x1 smaller
  if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); }  # y1 smaller

  if ($y2 < 0 || $x2 < 0) {
    return (1, 0); # rect all negative, no N
  }

  if ($x1 < 0) { $x1 *= 0; }   # "*=" to preserve bigint x1 or y1
  if ($y1 < 0) { $y1 *= 0; }

  # monotonic increasing in X and Y directions, so this is exact
  return ($self->xy_to_n ($x1, $y1),
          $self->xy_to_n ($x2, $y2));
}

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

#           arms=1
# level 1  0..0  = 1
# level 1  0..3  = 4
# level 2  0..15 = 16
#            4^k-1

# shared by Math::PlanePath::GrayCode and others
sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  $self->{'radix'}**(2*$level) - 1);
}
sub n_to_level {
  my ($self, $n) = @_;
  if ($n < 0) { return undef; }
  $n = round_nearest($n);
  my ($pow, $exp) = round_up_pow ($n+1, $self->{'radix'}*$self->{'radix'});
  return $exp;
}

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