File Coverage

blib/lib/Math/PlanePath/ImaginaryBase.pm

Criterion	Covered	Total	%
statement	122	152	80.2
branch	22	32	68.7
condition	6	6	100.0
subroutine	17	24	70.8
pod	10	10	100.0
total	177	224	79.0

# Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 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=ImaginaryBase --lines --scale=10
# math-image --path=ImaginaryBase --all --output=numbers_dash --size=80x50
#
# cf A005351 positives as negabinary index
#    A005352 negatives as negabinary index
#    A039724 positives as negabinary index, in binary
#    A027615 negabinary bit count
#            = 3 * A072894(n+1) - 2n - 3
#    A098725 first diffs of A072894
#    A000695 same value binary and negabinary, being base 4 digits 0,1
#    A001045 abs(negabinary) of 0b11111 all ones (2^n-(-1)^n)/3
#    A185269 negabinary primes
#
#    A073785 positives as -3 index
#    A007608 positives as -4 index
#    A073786 -5
#    A073787 -6
#    A073788 -7
#    A073789 -8
#    A073790 -9
#    A039723 positives as negadecimal index
#    A051022 same value integer and negadecimal, 0s between digits
#
# http://mathworld.wolfram.com/Negabinary.html
# http://mathworld.wolfram.com/Negadecimal.html

package Math::PlanePath::ImaginaryBase;
use 5.004;
use strict;
#use List::Util 'min','max';
*min = \&Math::PlanePath::_min;
*max = \&Math::PlanePath::_max;

use vars '$VERSION', '@ISA';
$VERSION = 129;
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
  'parameter_info_array', # radix parameter
  'round_down_pow',
  'round_up_pow',
  'digit_split_lowtohigh',
  'digit_join_lowtohigh';

use Math::PlanePath::ZOrderCurve;
*_digit_interleave = \&Math::PlanePath::ZOrderCurve::_digit_interleave;

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


use constant n_start => 0;
use constant xy_is_visited => 1;
use constant absdx_minimum => 1;   # X coord always changes

sub x_negative_at_n {
  my ($self) = @_;
  return $self->{'radix'}**2;
}
sub y_negative_at_n {
  my ($self) = @_;
  return $self->{'radix'}**3;
}

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

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) = @_;
  ### ImaginaryBase n_to_xy(): $n

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

  # ENHANCE-ME: lowest non-(r-1) digit determines direction to next, or
  # something like that
  {
    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 $radix = $self->{'radix'};
  my $x = 0;
  my $y = 0;
  my $len = ($n*0)+1;  # inherit bignum 1

  if (my @digits = digit_split_lowtohigh($n, $radix)) {
    $radix = -$radix;
    for (;;) {
      $x += (shift @digits) * $len;  # digits low to high
      @digits || last;

      $y += (shift @digits) * $len;  # digits low to high
      @digits || last;

      $len *= $radix;  # $radix negative negates each time
    }
  }

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

# ($x-$digit) and ($y-$digit) are multiples of $radix, but apply int() in
# case floating point rounding
#
sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### ImaginaryBase xy_to_n(): "$x, $y"

  $x = round_nearest ($x);
  if (is_infinite($x)) { return ($x); }

  $y = round_nearest ($y);
  if (is_infinite($y)) { return ($y); }

  my $radix = $self->{'radix'};
  my $zero = ($x * 0 * $y);  # inherit bignum 0
  my @n; # digits low to high

  while ($x || $y) {
    ### at: "x=$x,y=$y   n=".join(',',@n)

    push @n, _divrem_mutate ($x, $radix);
    $x = -$x;
    push @n, _divrem_mutate ($y, $radix);
    $y = -$y;
  }
  return digit_join_lowtohigh (\@n,$radix, $zero);
}

# left xmax = (r-1) + (r^2 -r) + (r^3-r^2) + ... + (r^k - r^(k-1))
#           = r^(k-1) - 1
#
# right xmin = - (r + r^3 + ... + r^(2k+1))
#            = -r * (1 + r^2 + ... + r^2k)
#            = -r * ((r^2)^(k+1) -1) / (r^2 - 1)
#

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

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

  my $zero = $x1 * 0 * $y1 * $x2 * $y2;
  my $radix = $self->{'radix'};

  my ($min_xdigits, $max_xdigits)
    = _negaradix_range_digits_lowtohigh($x1,$x2, $radix);
  unless (defined $min_xdigits) {
    return (0, $max_xdigits); # infinity
  }

  my ($min_ydigits, $max_ydigits)
    = _negaradix_range_digits_lowtohigh($y1,$y2, $radix);
  unless (defined $min_ydigits) {
    return (0, $max_ydigits); # infinity
  }

  ### $min_xdigits
  ### $max_xdigits
  ### min_x: digit_join_lowtohigh ($min_xdigits, $radix, $zero)
  ### max_x: digit_join_lowtohigh ($max_xdigits, $radix, $zero)
  ### $min_ydigits
  ### $max_ydigits
  ### min_y: digit_join_lowtohigh ($min_ydigits, $radix, $zero)
  ### max_y: digit_join_lowtohigh ($max_ydigits, $radix, $zero)

  my @min_digits = _digit_interleave ($min_xdigits, $min_ydigits);
  my @max_digits = _digit_interleave ($max_xdigits, $max_ydigits);

  ### final ...
  ### @min_digits
  ### @max_digits

  return (digit_join_lowtohigh (\@min_digits, $radix, $zero),
          digit_join_lowtohigh (\@max_digits, $radix, $zero));
}



# Return arrayrefs ($min_digits, $max_digits) which are the digits making
# up the index range for negaradix values $x1 to $x2 inclusive.
# The arrays are lowtohigh, so $min_digits->[0] is the least significant digit.
#
sub _negaradix_range_digits_lowtohigh {
  my ($x1,$x2, $radix) = @_;
  ### _negaradix_range_digits(): "$x1,$x2  radix=$radix"

  if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }  # make x1 <= x2

  my $radix_minus_1 = $radix - 1;
  ### $radix
  ### $radix_minus_1


  my ($len, $level, $min_base) = _negaradix_range_level ($x1,$x2, $radix);
  ### $len
  ### $level
  if (is_infinite($level)) {
    return (undef, $level);
  }
  my $max_base = $min_base;

  ### assert: $min_base <= $x1
  ### assert: $min_base + $len > $x2

  my @min_digits;   # digits formed high to low, stored low to high
  my @max_digits;
  while (--$level > 0) {
    $len /= $radix;
    ### at: "len=$len  reverse"

    # reversed digits, x1 low end for max, x2 high end for min
    {
      my $digit = max (0,
                       min ($radix_minus_1,
                            int (($x2 - $min_base) / $len)));
      ### min base: $min_base
      ### min diff: $x2-$min_base
      ### min digit raw: $digit
      ### min digit reversed: $radix_minus_1 - $digit
      $min_base += $digit * $len;
      $min_digits[$level] = $radix_minus_1 - $digit;
    }
    {
      my $digit = max (0,
                       min ($radix_minus_1,
                            int (($x1 - $max_base) / $len)));
      ### max base: $max_base
      ### max diff: $x1-$max_base
      ### max digit raw: $digit
      ### max digit reversed: $radix_minus_1 - $digit
      $max_base += $digit * $len;
      $max_digits[$level--] = $radix_minus_1 - $digit;
    }

    $len /= $radix;
    ### at: "len=$len  plain"

    # plain digits, x1 low end for min, x2 high end for max
    {
      my $digit = max (0,
                       min ($radix_minus_1,
                            int (($x1 - $min_base) / $len)));
      ### min base: $min_base
      ### min diff: $x1-$min_base
      ### min digit: $digit
      $min_base += $digit * $len;
      $min_digits[$level] = $digit;
    }
    {
      my $digit = max (0,
                       min ($radix_minus_1,
                            int (($x2 - $max_base) / $len)));
      ### max base: $max_base
      ### max diff: $x2-$max_base
      ### max digit: $digit
      $max_base += $digit * $len;
      $max_digits[$level] = $digit;
    }
  }
  ### @min_digits
  ### @max_digits
  return (\@min_digits, \@max_digits);
}

# return ($len,$level,$base)
# $level = number of digits in the bigest integer in negaradix $x1..$x2,
#          rounded up to be $level even
# $len = $radix**$level
# $base = lowest negaradix reached by indexes from 0 to $len-1
#
# have $base <= $x1, $x2 < $base+$len
# and $level is the smallest even number with that coverage
#
# negabinary
# 0,1,5,21
#
# negaternary
#   1  3  9 27  81 243
# 0,2,   20    182
#     -6   -60    -546
#
sub _negaradix_range_level {
  my ($x1,$x2, $radix) = @_;
  ### _negaradix_range_level(): "$x1,$x2  radix=$radix"
  ### assert: $x1 <= $x2

  my ($len, $level)
    = round_down_pow (max($radix - $x1*($radix + 1),
                          (($radix+1)*$x2 - 1) * $radix),
                      $radix);
  if ($level & 1) {
    ### increase level to even ...
    $len *= $radix;
    $level += 1;
  }
  ### $len
  ### $level

  # because level is even r^2k-1 is a multiple of r^2-1 and therefore of r+1
  ### assert: ($len-1) % ($radix+1) == 0

  return ($len,
          $level,
          ((1-$len) / ($radix+1)) * $radix);  # base
}


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

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

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