File Coverage

blib/lib/Math/PlanePath/LTiling.pm

Criterion	Covered	Total	%
statement	56	125	44.8
branch	10	54	18.5
condition	1	6	16.6
subroutine	14	19	73.6
pod	8	8	100.0
total	89	212	41.9

# 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::LTiling;
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
  'round_down_pow',
  'round_up_pow',
  '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;

use constant parameter_info_array =>
  [ { name            => 'L_fill',
      display         => 'L Fill',
      type            => 'enum',
      default         => 'middle',
      choices         => ['middle','left','upper','ends','all'],
      choices_display => ['Middle','Left','Upper','Ends','All'],
      description     => 'Which points to number with each "L".',
    },
  ];

my %sumxy_minimum = (middle => 0, # X=0,Y=0
                     left   => 1, # X=1,Y=0
                     upper  => 1, # X=0,Y=1
                     ends   => 1, # X=1,Y=0  and X=0,Y=1
                     all    => 0, # X=0,Y=0
                    );
sub sumxy_minimum {
  my ($self) = @_;
  return $sumxy_minimum{$self->{'L_fill'}};
}
*sumabsxy_minimum  = \&sumxy_minimum;
*absdiffxy_minimum = \&sumxy_minimum;
*rsquared_minimum  = \&sumxy_minimum;

{
  my %turn_any_straight = (# middle => 0,
                           left   => 1,
                           # upper  => 0,
                           ends   => 1,
                           all    => 1,
                          );
  sub turn_any_straight {
    my ($self) = @_;
    return $turn_any_straight{$self->{'L_fill'}};
  }
}

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

sub new {
  my $self = shift->SUPER::new (@_);
  my $L_fill = $self->{'L_fill'};
  if (! defined $L_fill) {
    $self->{'L_fill'} = 'middle';
  } elsif (! exists $sumxy_minimum{$L_fill}) {
    croak "Unrecognised L_fill option: ",$L_fill;
  }
  return $self;
}

sub n_to_xy {
  my ($self, $n) = @_;
  ### LTiling 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

  my $L_fill = $self->{'L_fill'};
  if ($L_fill eq 'left') {
    $x += 1;
  } elsif ($L_fill eq 'upper') {
    $y += 1;
  } elsif ($L_fill eq 'ends') {
    my $rem = _divrem_mutate ($n, 2);
    if ($rem) { # low digit==1
      $y = $len;  # 1
    } else { # low digit==0
      $x = $len;  # 1
    }
  } elsif ($L_fill eq 'all') {
    my $rem = _divrem_mutate ($n, 3);
    if ($rem == 1) {
      $x = $len;  # 1
    } elsif ($rem == 2) {
      $y = $len;  # 1
    }
  }

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

    if ($digit == 1) {
      ($x,$y) = (4*$len-1-$y,$x);
    } elsif ($digit == 2) {
      $x += $len;
      $y += $len;
    } elsif ($digit == 3) {
      ($x,$y) = ($y,4*$len-1-$x);
    }
    $len *= 2;
  }

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

my @yx_to_digit = ([0,0,1,1],
                   [0,2,2,1],
                   [3,2],
                   [3,3]);
my %fill_factor = (middle => 1,
                   left   => 1,
                   upper  => 1,
                   ends   => 2,
                   all    => 3);
my %yx_to_fill = (middle => [[0]],
                  left   => [[undef,0]],
                  upper   => [[],
                              [0]],
                  ends   => [[undef,0],
                             [1]],
                  all    => [[0,1],
                             [2]]);
sub xy_to_n {
  my ($self, $x, $y) = @_;
  ### LTiling xy_to_n(): "$x, $y"

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

  my ($len, $level) = round_down_pow (max($x,$y),
                                      2);
  if (is_infinite($level)) {
    return $level;
  }

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

  while ($level-- >= 0) {
    ### assert: $x >= 0
    ### assert: $y >= 0
    ### assert: ($y < 2*$len && $x < 4*$len) || ($x < 2*$len && $y < 4*$len)

    ### $len
    ### x: int($x/$len)
    ### y: int($y/$len)

    my $digit = $yx_to_digit[int($y/$len)]->[int($x/$len)];
    if ($digit == 1) {
      ($x,$y) = ($y,4*$len-1-$x);
    } elsif ($digit == 2) {
      $x -= $len;
      $y -= $len;
    } elsif ($digit == 3) {
      ($x,$y) = (4*$len-1-$y,$x);
    }

    ### to: "digit=$digit  xy=$x,$y"

    $n = $n*4 + $digit;
    $len /= 2;
  }

  ### assert: ($x==0 && $y== 0) || ($x==1 && $y== 0) || ($x==0 && $y== 1)

  my $fill = $self->{'L_fill'};
  if (defined (my $digit = $yx_to_fill{$fill}->[$y]->[$x])) {
    return $n*$fill_factor{$fill} + $digit;
  }
  return undef;
}

my %range_factor = (middle => 3,
                    left   => 3,
                    upper  => 3,
                    ends   => 6,
                    all    => 8);
# not exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  ### LTiling 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);
  }

  return (0,
          $len*$len * $range_factor{$self->{'L_fill'}});
}


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

sub level_to_n_range {
  my ($self, $level) = @_;
  return (0,  4**$level * $fill_factor{$self->{'L_fill'}} - 1);
}
sub n_to_level {
  my ($self, $n) = @_;
  if ($n < 0) { return undef; }
  if (is_infinite($n)) { return $n; }
  $n = round_nearest($n);
  _divrem_mutate ($n, $fill_factor{$self->{'L_fill'}});
  my ($pow, $exp) = round_up_pow ($n+1, 4);
  return $exp;
}

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