File Coverage

blib/lib/Math/PlanePath/GrayCode.pm

Criterion	Covered	Total	%
statement	99	170	58.2
branch	9	46	19.5
condition	6	48	12.5
subroutine	20	31	64.5
pod	10	10	100.0
total	144	305	47.2

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


# cf. A164677 position of Gray bit change, +/- according to 0->1 or 1->0.
#     (a signed version of A001511)

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

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

use Math::PlanePath::Base::Generic
  'is_infinite',
  'round_nearest';
use Math::PlanePath::Base::Digits
  '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;
*xy_is_visited = \&Math::PlanePath::Base::Generic::xy_is_visited_quad1;

use constant parameter_info_array =>
  [
   { name            => 'apply_type',
     share_key       => 'apply_type_TsF',
     display         => 'Apply Type',
     type            => 'enum',
     default         => 'TsF',
     choices         => ['TsF','Ts','Fs','FsT','sT','sF'],
     choices_display => ['TsF','Ts','Fs','FsT','sT','sF'],
     description     => 'How to apply the Gray coding to/from and split.',
   },
   { name             => 'gray_type',
     display          => 'Gray Type',
     type             => 'enum',
     default          => 'reflected',
     choices          => ['reflected','modular'],
     choices_dispaly  => ['Reflected','Modular'],
     description      => 'The type of Gray code.',
   },
   { %{Math::PlanePath::Base::Digits::parameter_info_radix2()},
     description => 'Radix, for both the Gray code and splitting.',
   },
  ];

sub _is_peano {
  my ($self) = @_;
  return ($self->{'radix'} % 2 == 1
          && $self->{'gray_type'} eq 'reflected'
          && ($self->{'apply_type'} eq 'TsF'
              || $self->{'apply_type'} eq 'FsT'));
}
sub dx_minimum {
  my ($self) = @_;
  return (_is_peano($self) ? -1 : undef);
}
*dy_minimum = \&dx_minimum;

sub dx_maximum {
  my ($self) = @_;
  return (_is_peano($self) ? 1 : undef);
}
*dy_maximum = \&dx_maximum;

{
  # Ror sT and sF the split X coordinate changes from N to N+1 and so does
  # the to-gray or from-gray transformation, so X always changes.
  #
  my %absdx_minimum = (
                      reflected => {
                                    # TsF => 0,
                                    # FsT => 0,
                                    # Ts  => 0,
                                    # Fs  => 0,
                                    sT    => 1,
                                    sF    => 1,
                                   },
                      modular   => {
                                    # TsF => 0,
                                    # Ts  => 0,
                                    Fs    => 1,
                                    FsT   => 1,
                                    sT    => 1,
                                    sF    => 1,
                                   },
                     );
  sub absdx_minimum {
    my ($self) = @_;
    my $gray_type = ($self->{'radix'} == 2
                     ? 'reflected'
                     : $self->{'gray_type'});
    return ($absdx_minimum{$gray_type}->{$self->{'apply_type'}} || 0);
  }
}

*dsumxy_minimum = \&dx_minimum;
*dsumxy_maximum = \&dx_maximum;
*ddiffxy_minimum = \&dx_minimum;
*ddiffxy_maximum = \&dx_maximum;

{
  my %dir_maximum_supremum = (
                      # # radix==2 always "reflected"
                      # # TsF => 0,
                      # # FsT => 0,
                      # # Ts => 0,
                      # # Fs => 0,
                      # sT => 4,
                      # sF => 4,

                      reflected => {
                                    # TsF => 0,
                                    # FsT => 0,
                                    # Ts  => 0,
                                    # Fs  => 0,
                                    sT    => 4,
                                    sF    => 4,
                                   },
                      modular   => {
                                    # TsF => 0,
                                    # Ts  => 0,
                                    Fs    => 4,
                                    FsT   => 4,
                                    sT    => 4,
                                    sF    => 4,
                                   },
                     );
  sub dir_maximum_dxdy {
    my ($self) = @_;
    my $gray_type = ($self->{'radix'} == 2
                     ? 'reflected'
                     : $self->{'gray_type'});
    return ($dir_maximum_supremum{$gray_type}->{$self->{'apply_type'}}
            ? (0,0)    # supremum
            : (0,-1)); # South
  }
}

# radix=2 TsF==Fs is always straight or left
sub turn_any_right {
  my ($self) = @_;
  if ($self->{'radix'} == 2
      && ($self->{'apply_type'} eq 'TsF'
          || $self->{'apply_type'} eq 'Fs')) {
    return 0; # never right
  }
  return 1;
}
sub turn_any_straight {
  my ($self) = @_;
  return ($self->{'radix'} == 2
          && ($self->{'apply_type'} eq 'sT' || $self->{'apply_type'} eq 'sF')
          ? 0   # never straight
          : 1);
}

sub _UNDOCUMENTED__turn_any_left_at_n {
  my ($self) = @_;
  return $self->{'radix'} - 1;
}
sub _UNDOCUMENTED__turn_any_right_at_n {
  my ($self) = @_;
  if ($self->{'apply_type'} eq 'TsF' && $self->{'gray_type'} eq 'reflected'
      && $self->{'radix'} > 2) {
    return 2*$self->{'radix'} - 1;
  }
  return undef;
}


#------------------------------------------------------------------------------
my %funcbase = (T  => '_digits_to_gray',
                F  => '_digits_from_gray',
                '' => '_noop');
my %inv = (T  => 'F',
           F  => 'T',
           '' => '');

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

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

  my $apply_type = ($self->{'apply_type'} ||= 'TsF');
  my $gray_type = ($self->{'gray_type'} ||= 'reflected');

  unless ($apply_type =~ /^([TF]?)s([TF]?)$/) {
    croak "Unrecognised apply_type \"$apply_type\"";
  }
  my $nf = $1;  # "T" or "F" or ""
  my $xyf = $2;

  $self->{'n_func'} = $self->can("$funcbase{$nf}_$gray_type")
    || croak "Unrecognised gray_type \"$self->{'gray_type'}\"";
  $self->{'xy_func'} = $self->can("$funcbase{$xyf}_$gray_type");

  $nf = $inv{$nf};
  $xyf = $inv{$xyf};

  $self->{'inverse_n_func'} = $self->can("$funcbase{$nf}_$gray_type");
  $self->{'inverse_xy_func'} = $self->can("$funcbase{$xyf}_$gray_type");

  return $self;
}

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

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

  {
    # ENHANCE-ME: N and N+1 differ by not much ...
    my $int = int($n);
    ### $int
    if ($n != $int) {
      my $frac = $n - $int;  # inherit possible BigFloat/BigRat
      ### $frac
      my ($x1,$y1) = $self->n_to_xy($int);
      my ($x2,$y2) = $self->n_to_xy($int+1);
      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 @digits = digit_split_lowtohigh($n,$radix);
  $self->{'n_func'}->(\@digits, $radix);

  my @xdigits;
  my @ydigits;
  while (@digits) {
    push @xdigits, shift @digits;        # low to high
    push @ydigits, shift @digits || 0;
  }
  my $xdigits = \@xdigits;
  my $ydigits = \@ydigits;
  $self->{'xy_func'}->($xdigits,$radix);
  $self->{'xy_func'}->($ydigits,$radix);

  return (digit_join_lowtohigh($xdigits,$radix),
          digit_join_lowtohigh($ydigits,$radix));
}

sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### GrayCode 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 @xdigits = digit_split_lowtohigh ($x, $radix);
  my @ydigits = digit_split_lowtohigh ($y, $radix);

  $self->{'inverse_xy_func'}->(\@xdigits, $radix);
  $self->{'inverse_xy_func'}->(\@ydigits, $radix);

  my @digits;
  for (;;) {
    (@xdigits || @ydigits) or last;
    push @digits, shift @xdigits || 0;
    (@xdigits || @ydigits) or last;
    push @digits, shift @ydigits || 0;
  }

  my $digits = \@digits;
  $self->{'inverse_n_func'}->($digits,$radix);

  return digit_join_lowtohigh($digits,$radix);
}

# not 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
  }

  my $radix = $self->{'radix'};
  my ($pow_max) = round_down_pow (max($x2,$y2), $radix);
  $pow_max *= $radix;
  return (0, $pow_max*$pow_max - 1);
}

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

use constant 1.02 _noop_reflected => undef;
use constant 1.02 _noop_modular   => undef;

# $aref->[0] low digit
sub _digits_to_gray_reflected {
  my ($aref, $radix) = @_;
  ### _digits_to_gray(): $aref
  $radix -= 1;
  my $reverse = 0;
  foreach my $digit (reverse @$aref) {  # high to low
    if ($reverse & 1) {
      $digit = $radix - $digit;  # radix-1 - digit
    }
    $reverse ^= $digit;
  }
}
# $aref->[0] low digit
sub _digits_to_gray_modular {
  my ($aref, $radix) = @_;
  my $prev = 0;
  foreach my $digit (reverse @$aref) {  # high to low
    ($digit,$prev) = (($digit - $prev) % $radix,   # mutate $aref->[i]
                      $digit);
  }
}

# $aref->[0] low digit
sub _digits_from_gray_reflected {
  my ($aref, $radix) = @_;
  $radix -= 1;                   # radix-1
  my $reverse = 0;
  foreach my $digit (reverse @$aref) {  # high to low
    if ($reverse & 1) {
      $reverse ^= $digit;        # before this reversal
      $digit = $radix - $digit;  # radix-1 - digit, mutate array
    } else {
      $reverse ^= $digit;
    }
  }
}
# $aref->[0] low digit
sub _digits_from_gray_modular {
  my ($aref, $radix) = @_;
  ### _digits_from_gray_modular(): $aref

  my $offset = 0;
  foreach my $digit (reverse @$aref) {  # high to low
    $offset = ($digit = ($digit + $offset) % $radix); # mutate $aref->[i]
  }
}

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

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

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