File Coverage

blib/lib/Math/PlanePath/ImaginaryHalf.pm

Criterion	Covered	Total	%
statement	106	149	71.1
branch	14	38	36.8
condition	15	28	53.5
subroutine	17	23	73.9
pod	8	8	100.0
total	160	246	65.0

# Copyright 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::ImaginaryHalf;
use 5.004;
use strict;
use Carp 'croak';
#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
  'digit_split_lowtohigh',
  'digit_join_lowtohigh';

use Math::PlanePath::ImaginaryBase;
*_negaradix_range_digits_lowtohigh
  = \&Math::PlanePath::ImaginaryBase::_negaradix_range_digits_lowtohigh;

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


use constant n_start => 0;
use constant class_y_negative => 0;
*xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad12;

use constant parameter_info_array =>
  [ Math::PlanePath::Base::Digits::parameter_info_radix2(),
    {
     name      => 'digit_order',
     share_key => 'digit_order_XYX',
     display   => 'Digit Order',
     type      => 'enum',
     default   => 'XYX',
     choices   => ['XYX',
                   'XXY',
                   'YXX',
                   'XnYX',
                   'XnXY',
                   'YXnX',
                  ],
    },
  ];

{
  my %x_negative_at_n = (XYX => 2,
                         XXY => 1,
                         YXX => 2,
                         XnYX => 0,
                         XnXY => 0,
                         YXnX => 1,
                        );
  sub x_negative_at_n {
    my ($self) = @_;
    return $self->{'radix'} ** $x_negative_at_n{$self->{'digit_order'}};
  }
}

# ENHANCE-ME: prove dY range
use constant dy_maximum => 1;

{
  my %absdx_minimum = (XYX => 1,
                       XXY => 1,
                       YXX => 0,   # dX=0 at N=0
                       XnYX => 2,  # dX=-2 at N=0
                       XnXY => 1,
                       YXnX => 0,  # dX=0 at N=0
                      );
  sub absdx_minimum {
    my ($self) = @_;
    return $absdx_minimum{$self->{'digit_order'}};
  }
}
{
  my %absdy_minimum = (XYX => 0,   # dY=0 at N=0
                       XXY => 0,   # dY=0 at N=0
                       YXX => 1,
                       XnYX => 0,   # dY=0 at N=0
                       XnXY => 0,   # dY=0 at N=0
                       YXnX => 1,
                      );
  sub absdy_minimum {
    my ($self) = @_;
    return $absdy_minimum{$self->{'digit_order'}};
  }
}

# was this anything?
#
# sub dir4_minimum {
#   my ($self) = @_;
#   if ($self->{'digit_order'} eq 'zzXYX') {
#     return Math::NumSeq::PlanePathDelta::_delta_func_Dir4
#       ($self->{'radix'}-1,-2);
#   } else {
#     return 0;
#   }
# }

{
  # radix>2 has a straight somewhere
  # radix=2 only has straight in XXY, XnXY
  my %turn_any_straight = (# XYX    => 0,
                           XXY  => 1,
                           # YXX    => 0,
                           XnXY => 1,
                           # XnYX   => 0,
                           # YXnX   => 0,
                          );
  sub turn_any_straight {
    my ($self) = @_;
    return ($self->{'radix'} > 2
            || $turn_any_straight{$self->{'digit_order'}});
  }
}

sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  my $digit_order = $self->{'digit_order'};
  my $radix = $self->{'radix'};
  if ($digit_order eq 'XXY') {
    return $radix*$radix - 1;
  }
  if ($digit_order eq 'YXX' || $digit_order eq 'XnYX') {
    return $radix;
  }
  if ($digit_order eq 'XnXY') {
    return $radix*$radix ;
  }
  return $radix - 1;
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  my $digit_order = $self->{'digit_order'};
  my $radix = $self->{'radix'};
  if ($digit_order eq 'XXY') {
    return $radix*$radix;
  }
  if ($digit_order eq 'XnXY') {
    return $radix*$radix - 1;
  }
  if ($digit_order eq 'YXX' || $digit_order eq 'XnYX') {
    return $radix - 1;
  }
  return $radix;
}


#------------------------------------------------------------------------------
my %digit_permutation = (XYX => [0,2,1],
                         YXX => [2,0,1],
                         XXY => [0,1,2],

                         XnYX => [1,2,0],
                         YXnX => [2,1,0],
                         XnXY => [1,0,2],
                        );

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

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

  my $digit_order = ($self->{'digit_order'} ||= 'XYX');
  $self->{'digit_permutation'} = $digit_permutation{$digit_order}
    || croak "Unrecognised digit_order: ",$digit_order;

  return $self;
}

sub n_to_xy {
  my ($self, $n) = @_;
  ### ImaginaryHalf 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 $radix = $self->{'radix'};
  my $zero = ($n*0); # inherit bignum 0

  my @xydigits = ([],[0],[]);
  my $digit_permutation = $digit_permutation{$self->{'digit_order'}};
  my @ndigits = digit_split_lowtohigh($n, $radix);
  foreach my $i (0 .. $#ndigits) {
    my $p = $digit_permutation->[$i%3];
    push @{$xydigits[$p]}, $ndigits[$i], ($p < 2 ? (0) : ());
  }

  return (digit_join_lowtohigh ($xydigits[0], $radix, $zero)
          - digit_join_lowtohigh ($xydigits[1], $radix, $zero),
          digit_join_lowtohigh ($xydigits[2], $radix, $zero));
}

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

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

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

  my $zero = ($x * 0 * $y);  # inherit bignum 0
  my $radix = $self->{'radix'};
  my @ydigits = digit_split_lowtohigh($y, $radix);
  my $digit_permutation = $digit_permutation{$self->{'digit_order'}};

  my @ndigits; # digits low to high
  my @nd;
  while ($x || @ydigits) {
    $nd[0] = _divrem_mutate ($x, $radix);
    $x = -$x;
    $nd[1] = _divrem_mutate ($x, $radix);
    $x = -$x;
    $nd[2] = shift @ydigits || 0;

    push @ndigits,
      $nd[$digit_permutation->[0]],
        $nd[$digit_permutation->[1]],
          $nd[$digit_permutation->[2]];
  }
  return digit_join_lowtohigh (\@ndigits, $radix, $zero);
}

# Nlevel=2^level-1
#    66666666 55 55 5555 7.[16].7
#    66666666 55 55 5555 7.[16].7
#    66666666 33 22 4444 7.[16].7
#  9 66666666 33 01 4444 7.[16].7
#  ^        ^  ^  ^ ^    ^        ^
# -11      -3 -1  1 2    6       22
#
# X=1     when level=1
# X=1+1=2 when level=4
# X=2+4=6 when level=7
# X=6+16=22 when level=10
#
# X=0-2=-2 when level=3
# X=-2-8=-10  when level=6
# X=-10-32=-42 when level=9
#
# Y=1 k=0 want level=2
# Y=2 k=1 want level=5
# Y=4 k=2 want level=8
#
# X = 1 + 1 + 4 + 16 + 4^k
#   = 1 + (4^(k+1) - 1) / (4-1)
# X*(R2-1) = (R2-1) + R2^(k+1) - 1
# X*(R2-1) + 1 - (R2-1) = R2^(k+1)
# R2^(k+1) = (X-1)*(R2-1) + 1
# k+1 = round down pow (X-1)*(R2-1) + 1
# (1-1)*3+1=1    k+1=0   want level=1
# (2-1)*3+1=4    k+1=1   want level=4
# (6-1)*3+1=16   k+1=2   want level=7
# (22-1)*3+1=64  k+1=3   want level=10
#
# X = 1 + 2 + 8 + 32 + ... 2*4^k
#   = 1 + 2*(4^(k+1) - 1) / (4-1)
# X = 1 + R*(R2^(k+1) - 1) / (R2-1)
# R*(R2^(k+1) - 1) / (R2-1) = X-1
# R2^(k+1) - 1 = (X-1)*(R2-1)/R
# R2^(k+2) - R2 = (X-1)*(R2-1)*R
# R2^(k+2) = (X-1)*(R2-1)*R + R2
# (1-1)*3*2+4=4   k+2=1 want level=3
# (3-1)*3*2+4=16  k+2=2 want level=6
# (11-1)*3*2+4=64 k+2=3 want level=9

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

  my $zero = $x1 * 0 * $x2 * $y1 * $y2;

  $y1 = round_nearest($y1);
  $y2 = round_nearest($y2);
  ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
  if ($y2 < 0) {
    ### rectangle all Y negative, no points ...
    return (1, 0);
  }
  if (is_infinite($y2)) {
    return (0, $y2);
  }
  if ($y1 < 0) { $y1 *= 0; }   # "*=" to preserve bigint y1

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

  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 = digit_split_lowtohigh ($y1, $radix);
  my @max_ydigits = digit_split_lowtohigh ($y2, $radix);

  my $digit_permutation = $digit_permutation{$self->{'digit_order'}};
  my @min_ndigits
    = _digit_permutation_interleave ($digit_permutation,
                                     $min_xdigits, \@min_ydigits);
  my @max_ndigits
    = _digit_permutation_interleave ($digit_permutation,
                                     $max_xdigits, \@max_ydigits);

  return (digit_join_lowtohigh (\@min_ndigits, $radix, $zero),
          digit_join_lowtohigh (\@max_ndigits, $radix, $zero));
}

sub _digit_permutation_interleave {
  my ($digit_permutation, $xaref, $yaref) = @_;
  my @ret;
  my @d;
  foreach (0 .. max($#$xaref,2*$#$yaref)) {
    $d[0] = shift @$xaref || 0;
    $d[1] = shift @$xaref || 0;
    $d[2] = shift @$yaref || 0;
    push @ret,
      $d[$digit_permutation->[0]],
        $d[$digit_permutation->[1]],
          $d[$digit_permutation->[2]];
  }
  return @ret;
}

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

*level_to_n_range = \&Math::PlanePath::ImaginaryBase::level_to_n_range;
*n_to_level = \&Math::PlanePath::ImaginaryBase::n_to_level;

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