File Coverage

blib/lib/Math/PlanePath/PeanoDiagonals.pm

Criterion	Covered	Total	%
statement	99	114	86.8
branch	26	38	68.4
condition	7	12	58.3
subroutine	23	26	88.4
pod	7	7	100.0
total	162	197	82.2

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


package Math::PlanePath::PeanoDiagonals;
use 5.004;
use strict;

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

use Math::PlanePath;
*max = \&Math::PlanePath::_max;

use Math::PlanePath::PeanoCurve;
*_n_to_xykk = \&Math::PlanePath::PeanoCurve::_n_to_xykk;
*_xykk_to_n = \&Math::PlanePath::PeanoCurve::_xykk_to_n;

use Math::PlanePath::Base::Generic
  'is_infinite',
  'round_nearest';
use Math::PlanePath::Base::Digits
  'round_up_pow',
  'round_down_pow',
  'digit_split_lowtohigh',
  'digit_join_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;
use constant turn_any_straight => 0; # never straight

use constant dx_minimum => -1;
use constant dx_maximum => 1;
use constant dy_minimum => -1;
use constant dy_maximum => 1;

use constant parameter_info_array =>
  [ { name      => 'radix',
      share_key => 'radix_3',
      display   => 'Radix',
      type      => 'integer',
      minimum   => 2,
      default   => 3,
      width     => 3,
    } ];

# odd radix is unit steps diagonally,
# even radix unlimited
sub _UNDOCUMENTED__dxdy_list {
  my ($self) = @_;
  return ($self->{'radix'} % 2
          ? (1,1, -1,1, -1,-1, 1,-1)
          : ());   # even, unlimited
}

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

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

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

  my $frac;
  {
    my $int = int($n);
    $frac = $n - $int;  # inherit possible BigFloat
    $n = $int;
  }

  my ($x,$y, $xk,$yk) = _n_to_xykk($self,$n);
  ### xykk: "$x,$y  $xk,$yk"

  return ($x + ($xk&1 ? 1-$frac : $frac),
          $y + ($yk&1 ? 1-$frac : $frac));
}

sub xy_to_n {
  return scalar((shift->xy_to_n_list(@_))[0]);
}
sub xy_to_n_list {
  my ($self, $x, $y) = @_;
  ### PeanoDiagonals xy_to_n(): "$x, $y"

  # For odd radix, if X is even then segments are NE or SW, so offset 0,0 or
  # 1,1 to go to "middle" points.  Conversely if X is odd then segments are
  # NW or SE so offset 0,1 or 1,0.
  #
  # ENHANCE-ME: For odd radix, the two offsets are exactly the two visits.
  # Should be able to pay attention to the low 0s or 2s and so have the
  # digits of both N in one look.
  #
  # ENHANCE-ME: Is the offset rule for even radix found as easily?

  $x = round_nearest ($x);
  $y = round_nearest ($y);

  if ($x < 0 || $y < 0) { return; }
  if (is_infinite($x)) { return $x; }
  if (is_infinite($y)) { return $y; }

  return
    sort {$a<=>$b}
    map {_xykk_to_n($self, $x,$y, @$_)}
    ($self->{'radix'}&1
     ? ($x&1 ? ([0,1],[1,0]) : ([0,0],[1,1]))
     : ([0,0],[1,1], [0,1],[1,0]));
}


#------------------------------------------------------------------------------
# not exact
# block 0 .. 3^k-1 contains all

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);
  ($x1,$x2) = ($x2,$x1) if $x1 > $x2;
  ($y1,$y2) = ($y2,$y1) if $y1 > $y2;
  ### rect_to_n_range(): "$x1,$y1 to $x2,$y2"

  if ($x2 < 0 || $y2 < 0) {
    return (1, 0);
  }

  my $radix = $self->{'radix'};

  my ($power, $level) = round_down_pow (max($x2,$y2)*$radix, $radix);
  if (is_infinite($level)) {
    return (0, $level);
  }
  return (0, $power*$power - 1);
}

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

sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  $self->{'radix'}**(2*$level));
}
sub n_to_level {
  my ($self, $n) = @_;
  if ($n < 0) { return undef; }
  $n = round_nearest($n);
  my ($pow, $exp) = round_up_pow ($n, $self->{'radix'}*$self->{'radix'});
  return $exp;
}

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

# num low ternary 0s, and whether odd or even above there which is parity of
# how many 1-digits
#
sub _UNDOCUMENTED__n_to_turn_LSR {
  my ($self, $n) = @_;
  if ($n < 1 || is_infinite($n)) { return undef; }
  my $radix = $self->{'radix'};
  if ($radix & 1) {
    my $turn = 1;
    until ($n % $radix) {              # parity of low 0s
      $turn = -$turn;
      $n /= $radix;
    }
    return ($n % 2 ? -$turn : $turn);  # and flip again if odd
  }
  return $self->SUPER::_UNDOCUMENTED__n_to_turn_LSR($n);
}

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

1;
__END__