File Coverage

blib/lib/Math/PlanePath/CornerReplicate.pm

Criterion	Covered	Total	%
statement	110	167	65.8
branch	35	68	51.4
condition	6	10	60.0
subroutine	18	20	90.0
pod	4	4	100.0
total	173	269	64.3

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


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

use vars '$VERSION', '@ISA';
$VERSION = 127;
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',
  'bit_split_lowtohigh',
  'digit_split_lowtohigh';

# 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 dy_maximum => 1;     # dY=1,-1,-3,-7,-15,etc only
use constant dsumxy_maximum => 1;
use constant ddiffxy_minimum => -1;
use constant dir_maximum_dxdy => (2,-1);  # ESE
use constant turn_any_straight => 0; # never straight


#------------------------------------------------------------------------------
my @digit_to_x = (0,1,1,0);
my @digit_to_y = (0,0,1,1);

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

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

  {
    my $int = int($n);
    ### $int
    ### $n
    if ($n != $int) {
      my ($x1,$y1) = $self->n_to_xy($int);
      my ($x2,$y2) = $self->n_to_xy($int+1);
      my $frac = $n - $int;  # inherit possible BigFloat
      my $dx = $x2-$x1;
      my $dy = $y2-$y1;
      return ($frac*$dx + $x1, $frac*$dy + $y1);
    }
    $n = $int;       # BigFloat int() gives BigInt, use that
  }

  my $x = my $y = ($n * 0);  # inherit bignum 0
  my $len = $x + 1;          # inherit bignum 1

  foreach my $digit (digit_split_lowtohigh($n,4)) {
    ### at: "$x,$y  digit=$digit"

    $x += $digit_to_x[$digit] * $len;
    $y += $digit_to_y[$digit] * $len;
    $len *= 2;
  }

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

my @digit_to_next_dx = (1, 0, -1, -1);
my @digit_to_next_dy = (0, 1,  0, 0);

# use Smart::Comments;
sub n_to_dxdy {
  my ($self, $n) = @_;
  ### CornerReplicate n_to_dxdy(): $n

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

  my $zero = $n * 0;
  my $int = int($n);
  $n -= $int;  # fractional part

  my $digit = _divrem_mutate($int,4);
  ### low digit: $digit

  if ($digit == 0) {
    # N = "...0" eg. N=0
    #     ^
    #     |   this dX=1,dY=0
    # N---*   next dX=0,dY=1
    # dX = dXthis*(1-frac) + dXnext*frac
    #    = 1*(1-frac) + 0*frac
    #    = 1-frac
    # dY = dYthis*(1-frac) + dYnext*frac
    #    = 0*(1-frac) + 1*frac
    #    = frac
    return (1-$n,$n);
  }

  if ($digit == 1) {
    # N = "...1" eg. N=1
    # <---*
    #     |   this dX=0,dY=1
    #     N   next dX=-1,dY=0
    # dX = dXthis*(1-frac) + dXnext*frac
    #    = 0*(1-frac) + -1*frac
    #    = -frac
    # dY = dYthis*(1-frac) + dYnext*frac
    #    = 1*(1-frac) + 0*frac
    #    = 1-frac
    return (-$n,1-$n);
  }

  my ($dx,$dy);
  if ($digit == 2) {
    # N="...2"
    #  *---N     this dX=-1, dY=0
    #   \        next dX=power, dY=power
    #    \
    # power part for next only needed if $n fractional
    $dx = -1;
    $dy = 0;

    if ($n) {
      # N = "[digit]333..3332"
      (my $exp, $digit) = _count_low_base4_3s($int);

      if ($digit == 1) {
        # N = "1333..3332" so N=6, N=30, N=126, ...
        #  ^
        #  |         this dX=-1, dY=0
        #  *---N     next dX=0, dY=+1
        # dX = dXthis*(1-frac) + dXnext*frac
        #    = -1*(1-frac) + 0*frac
        #    = frac-1
        # dY = dYthis*(1-frac) + dYnext*frac
        #    = 0*(1-frac) + 1*frac
        #    = frac
        return ($n-1, $n);
      }

      my $next_dx = (2+$zero) ** ($exp+1);
      my $next_dy;
      ### power: $dx

      if ($digit) { # $digit == 2
        # N = "2333..3332" so N=10, N=14, N=62, ...
        #    *---N     this dX=-1, dY=0
        #   /          next dX=-2^k, dY=-(2^k-1)=1-2^k
        #  /
        $next_dx = -$next_dx;
        $next_dy = $next_dx+1;
      } else {            # $digit == 0
        # N = "0333..3332" so N=2, N=14, N=62, ...
        #  *---N     this dX=-1, dY=0
        #   \        next dX=+2^k, dY=-(2^k-1)=1-2^k
        #    \
        $next_dy = 1-$next_dx;
      }

      my $f1 = 1-$n;
      $dx = $f1*$dx + $n*$next_dx;
      $dy = $f1*$dy + $n*$next_dy;
    }

  } else { # $digit == 3
    my ($exp, $digit) = _count_low_base4_3s($int);
    ### $exp
    ### $digit

    if ($digit == 1) {
      # N   = "1333..333" eg. N=31
      # N+1 = "2000..000" eg. N=32
      # *--->
      # |      this dX=0, dY=+1
      # N      next dX=+1, dY=0
      # dX = dXthis*(1-frac) + dXnext*frac
      #    = 0*(1-frac) + 1*frac
      #    = frac
      # dY = dYthis*(1-frac) + dYnext*frac
      #    = 1*(1-frac) + 0*frac
      #    = 1-frac
      return ($n, 1-$n);
    }

    $dx = (2+$zero) ** ($exp+1);
    ### power: $dx
    if ($digit) { # $digit == 2
      # N = "2333..333" so N=11, N=47, N=191
      #    N
      #   /       this dX=-2^k, dY=-(2^k-1)=1-2^k
      #  /        next dX=1, dY=0
      # *->
      $dx = -$dx;
      $dy = $dx+1;
    } else {            # $digit == 0
      # N = "0333..333" so N=3, N=15, N=63, ...
      # N
      #  \        this dX=2^k, dY=-(2^k-1)=1-2^k
      #   \       next dX=1, dY=0
      #    *->
      $dy = 1-$dx;
    }

    if ($n) {
      # dX*(1-frac) + nextdX*frac
      # dY*(1-frac) + nextdY*frac
      # nextdX=1, nextdY=0
      my $f1 = 1-$n;
      $dx = $f1*$dx + $n;
      $dy = $f1*$dy;
    }
  }
  ### final: "$dx,$dy"
  return ($dx,$dy);
}

# Return ($count,$digit) where $count is how many trailing 3s on $n
# (possibly 0), and $digit is the next digit above those 3s.
sub _count_low_base4_3s {
  my ($n) = @_;
  my $count =0;
  for (;;) {
    my $digit = _divrem_mutate($n,4);
    if ($digit != 3) {
      return ($count,$digit);
    }
    $count++
  }
}

# my @yx_to_digit = ([0,1],
#                    [3,2]);
sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### CornerReplicate 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 @xbits = bit_split_lowtohigh($x);
  my @ybits = bit_split_lowtohigh($y);

  my $n = ($x * 0 * $y); # inherit bignum 0
  foreach my $i (reverse 0 .. max($#xbits,$#ybits)) {  # high to low
    $n *= 4;
    my $ydigit = $ybits[$i] || 0;
    $n += 2*$ydigit + (($xbits[$i]||0) ^ $ydigit);
  }
  return $n;
}

# these tables generated by tools/corner-replicate-table.pl
my @min_digit = (0,0,1, 0,0,1, 3,2,2);
my @max_digit = (0,1,1, 3,3,2, 3,3,2);

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

  $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: "X = $x1 to $x2, Y = $y1 to $y2"

  if ($x2 < 0 || $y2 < 0) {
    ### rectangle outside first quadrant ...
    return (1, 0);
  }

  my ($len, $level) = round_down_pow (max($x2,$y2), 2);
  ### $len
  ### $level
  if (is_infinite($level)) {
    return (0,$level);
  }

  my $n_min = my $n_max
    = my $x_min = my $y_min
      = my $x_max = my $y_max
        = ($x1 * 0 * $x2 * $y1 * $y2); # inherit bignum 0

  while ($level-- >= 0) {
    ### $level

    {
      my $x_cmp = $x_max + $len;
      my $y_cmp = $y_max + $len;
      my $digit = $max_digit[($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
                             + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0)];
      $n_max = 4*$n_max + $digit;
      if ($digit_to_x[$digit]) { $x_max += $len; }
      if ($digit_to_y[$digit]) { $y_max += $len; }

      # my $key = ($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
      #   + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0);
      ### max ...
      ### len:  sprintf "%#X", $len
      ### $x_cmp
      ### $y_cmp
      # ### $key
      ### $digit
      ### n_max: sprintf "%#X", $n_max
      ### $x_max
      ### $y_max
    }

    {
      my $x_cmp = $x_min + $len;
      my $y_cmp = $y_min + $len;
      my $digit = $min_digit[($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
                             + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0)];
      $n_min = 4*$n_min + $digit;
      if ($digit_to_x[$digit]) { $x_min += $len; }
      if ($digit_to_y[$digit]) { $y_min += $len; }

      # my $key = ($x1 >= $x_cmp ? 2 : $x2 >= $x_cmp ? 1 : 0)
      #   + ($y1 >= $y_cmp ? 6 : $y2 >= $y_cmp ? 3 : 0);
      ### min ...
      ### len:  sprintf "%#X", $len
      ### $x_cmp
      ### $y_cmp
      # ### $key
      ### $digit
      ### n_min: sprintf "%#X", $n_min
      ### $x_min
      ### $y_min
    }
    $len /= 2;
  }

  return ($n_min, $n_max);
}

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

use Math::PlanePath::HilbertCurve;
*level_to_n_range = \&Math::PlanePath::HilbertCurve::level_to_n_range;
*n_to_level       = \&Math::PlanePath::HilbertCurve::n_to_level;

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