File Coverage

blib/lib/Math/PlanePath/PyramidRows.pm

Criterion	Covered	Total	%
statement	78	119	65.5
branch	22	60	36.6
condition	18	35	51.4
subroutine	16	33	48.4
pod	21	21	100.0
total	155	268	57.8

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


# rule=50,58,114,122,178,179,186,242,250
# spacing=2,step=1
# full V with points spaced apart
# math-image --path=CellularRule,rule=50 --all --text
#
# A091018, A090894 using n_start=0
# A196199, A000196, A053186 using n_start=0

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

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

use Math::PlanePath::Base::Generic
  'round_nearest';

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


use constant class_y_negative => 0;
use constant n_frac_discontinuity => .5;

use constant parameter_info_array =>
  [ { name        => 'step',
      share_key   => 'step_2',
      display     => 'Step',
      type        => 'integer',
      minimum     => 0,
      default     => 2,
      width       => 2,
      description => 'How much longer each row is than the preceding.',
    },
    { name            => 'align',
      type            => 'enum',
      share_key       => 'align_crl',
      display         => 'Align',
      default         => 'centre',
      choices         => ['centre', 'right', 'left'],
      choices_display => ['Centre', 'Right', 'Left'],
    },
    Math::PlanePath::Base::Generic::parameter_info_nstart1(),
  ];

{
  my %align_x_negative_step = (left   => 1,
                               centre => 2);
  sub x_negative {
    my ($self) = @_;
    my $align = $self->{'align'};
    return ($align ne 'right'
            && $self->{'step'} >= $align_x_negative_step{$align});
  }
}
sub x_maximum {
  my ($self) = @_;
  return ($self->{'step'} == 0 || $self->{'align'} eq 'left'
          ? 0    # X=0 vertical, or left X<=0
          : undef);
}
{
  my %x_negative_at_n = (left  => 3,
                         right => 5,
                         up    => 3,
                         down  => 5);
  sub x_negative_at_n {
    my ($self) = @_;
    return (($self->{'align'} eq 'left' && $self->{'step'} >= 1)
            || ($self->{'align'} eq 'centre' && $self->{'step'} >= 2)
            ? $self->n_start + 1
            : undef);
  }
}
sub sumxy_minimum {
  my ($self) = @_;
  # for align=left   step<=1 has X>=-Y so X+Y >= 0
  # for align=centre step<=3 has X>=-Y so X+Y >= 0
  # for align=right X>=0 so X+Y >= 0
  return (($self->{'align'}    eq 'left'   && $self->{'step'} <= 1)
          || ($self->{'align'} eq 'centre' && $self->{'step'} <= 3)
          || ($self->{'align'} eq 'right')
          ? 0
          : undef);
}
sub diffxy_maximum {
  my ($self) = @_;
  # for align=left   X<=0 so X-Y<=0 always
  # for align=centre step<=2 has X<=Y so X-Y<=0
  # for align=right  step<=1 has X<=Y so X-Y<=0
  return (($self->{'align'}    eq 'left')
          || ($self->{'align'} eq 'centre' && $self->{'step'} <= 2)
          || ($self->{'align'} eq 'right'  && $self->{'step'} <= 1)
          ? 0
          : undef);
}

sub dx_minimum {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? 0 : undef);
}
sub dx_maximum {
  my ($self) = @_;
  return ($self->{'step'} == 0
          ? 0    # vertical only
          : 1);  # East
}

sub dy_minimum {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? 1 : 0);
}
use constant dy_maximum => 1;
sub _UNDOCUMENTED__dxdy_list {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? (0,1) # N always
          : ());
}

sub absdx_minimum {
  my ($self) = @_;
  return ($self->{'step'} == 0
          || $self->{'align'} eq 'right' # dX=0 at N=1
          || ($self->{'step'} == 1 && $self->{'align'} eq 'centre')
          ? 0 : 1);
}
sub absdy_minimum {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? 1 : 0);
}

# within row X increasing dSum=1
# end row decrease by big
sub dsumxy_minimum {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? 1 : undef);
}
use constant dsumxy_maximum => 1;
sub ddiffxy_minimum {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? -1  # constant North dY=1
          : undef);
}
sub ddiffxy_maximum {
  my ($self) = @_;
  return ($self->{'step'} == 0 ? -1  # constant North dY=1
          : 1);
}

sub dir_minimum_dxdy {
  my ($self) = @_;
  return ($self->{'step'} == 0
          ? (0,1)    # north only
          : (1,0));  # east
}
sub dir_maximum_dxdy {
  my ($self) = @_;
  return ($self->{'step'} == 0
          ? (0,1)    # north only
          : (-1,0)); # supremum, west and 1 up
}

sub turn_any_left {
  my ($self) = @_;
  return ($self->{'step'} != 0);  # always straight vertical only
}
*turn_any_right = \&turn_any_left;


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

my %align_known = (left   => 1,
                   right  => 1,
                   centre => 1);

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

  if (! defined $self->{'n_start'}) {
    $self->{'n_start'} = $self->default_n_start;
  }

  my $align = ($self->{'align'} ||= 'centre');
  $align_known{$align}
    or croak "Unrecognised align option: ",$align;

  my $step = $self->{'step'};
  $step = $self->{'step'} =
    (! defined $step ? 2 # default
     : $step < 0     ? 0 # minimum
     : $step);

  my $left_slope = $self->{'left_slope'} = ($align eq 'left' ? $step
                                            : $align eq 'right' ? 0
                                            : int($step/2));  # 'centre'
  my $right_slope = $self->{'right_slope'} = $step - $left_slope;

  # "b" term in the quadratic giving N on the Y axis
  $self->{'axis_b'} = $left_slope - $right_slope + 2;

  ### $align
  ### $step
  ### $left_slope
  ### right_slope: $self->{'right_slope'}

  return $self;
}

# step==2 row line beginning at x=-0.5,
# y =          0    1    2    3     4
# N start  = -0.5  1.5  4.5  9.5  16.5
#
#
# step==1
#   N = (1/2*$d^2 + 1/2*$d + 1/2)
#   s = -1/2 + sqrt(2 * $n + -3/4)
# step==2
#   N = ($d^2 + 1/2)
#   s = 0 + sqrt(1 * $n + -1/2)
# step==3
#   N = (3/2*$d^2 + -1/2*$d + 1/2)
#   s = 1/6 + sqrt(2/3 * $n + -11/36)
# step==4
#   N = (2*$d^2 + -1*$d + 1/2)
#   s = 1/4 + sqrt(1/2 * $n + -3/16)
#
# a = $step / 2
# b = 1 - $step / 2 = (2-$step)/2
# c = 0.5
#
# s = (-b + sqrt(4*a*$n + b*b - 4*a*c)) / 2*a
#   = (-b + sqrt(2*$step*$n + b*b - 2*$step*c)) / $step
#   = (-b + sqrt(2*$step*$n + b*b - $step)) / $step
#
# N = a*s*s + b*s + c
#   = $step/2 *s*s + (-$step+2)/2 * s + 1/2
#   = ($step * $d*$d - ($step-2)*$d + 1) / 2
#
# left at - 0.5 - $d*int($step/2)
# so x = $n - (($step * $d*$d - ($step-2)*$d + 1) / 2) - 0.5 - $d*int($step/2)
#      = $n - (($step * $d*$d - ($step-2)*$d + 1) / 2 + 0.5 + $d*int($step/2))
#      = $n - ($step/2 * $d*$d - ($step-2)/2*$d + 1/2 + 0.5 + $d*int($step/2))
#      = $n - ($step/2 * $d*$d - ($step-2)/2*$d + 1 + $d*int($step/2))
#      = $n - ($step/2 * $d*$d - ($step-2)/2*$d + int($step/2)*$d + 1)
#      = $n - ($step/2 * $d*$d - (($step-2)/2 - int($step/2))*$d + 1)
#      = $n - ($step/2 * $d*$d - ($step/2 - int($step/2) - 1)*$d + 1)
#      = $n - ($step/2 * $d*$d - (($step&1)/2 - 1)*$d + 1)
#      = $n - ($step * $d*$d - (($step&1) - 2)*$d + 2)/2
#
sub n_to_xy {
  my ($self, $n) = @_;
  ### PyramidRows n_to_xy(): $n

  # adjust to N=1 at origin X=0,Y=0
  $n = $n - $self->{'n_start'} + 1;

  # $n<0.5 no good for Math::BigInt circa Perl 5.12, compare in integers
  return if 2*$n < 1;

  my $step = $self->{'step'};
  if ($step == 0) {
    # step==0 is vertical line starting N=1 at Y=0
    my $int = round_nearest($n);
    return ($n-$int, $int-1);
  }

  my $neg_b = $step-2;
  my $y = int (($neg_b + _sqrtint(8*$step*$n + $neg_b*$neg_b - 4*$step))
               / (2*$step));

  ### d frac: (($neg_b + sqrt(int(8*$step*$n) + $neg_b*$neg_b - 4*$step)) / (2*$step))
  ### $y
  ### centre N: (($self->{'step'}*$y + $self->{'axis_b'})*$y/2+1)

  return ($n - (($self->{'step'}*$y + $self->{'axis_b'})*$y/2+1),
          $y);
}

sub n_to_radius {
  my ($self, $n) = @_;
  if ($self->{'step'} == 0) {
    $n = $n - $self->{'n_start'};  # to N=0 basis
    if ($n < 0) { return undef; }
    return $n;  # vertical on Y axis, including $n=+infinity or nan
  }
  return $self->SUPER::n_to_radius($n);
}

# N = ($step * $y*$y - ($step-2)*$y + 1) / 2
#
# right polygonal
# P(i) = (k-2)/2 * i*(i+1) - (k-3)*i
#      = [(k-2)/2 *(i+1) - (k-3) ]*i
#      = [(k-2)*(i+1) - 2*(k-3) ]/2*i
#      = [(k-2)*i + k-2 - 2*(k-3) ]/2*i
#      = [(k-2)*i + k-2 - 2k+6) ]/2*i
#      = [(k-2)*i + -k+4 ]/2*i
#
sub xy_to_n {
  my ($self, $x, $y) = @_;
  $x = round_nearest ($x);
  $y = round_nearest ($y);

  if ($y < 0
      || $x < -$y*$self->{'left_slope'}
      || $x > $y*$self->{'right_slope'}) {
    return undef;
  }
  return (($self->{'step'}*$y + $self->{'axis_b'})*$y/2
          + $x
          + $self->{'n_start'});
}

# left N   = ($step * $d*$d - ($step-2)*$d + 1) / 2
# plus .5  = ($step * $d*$d - ($step-2)*$d) / 2 + 1
#          = (($step * $d - ($step-2))*$d) / 2 + 1
#
# left X  = - $d*int($step/2)
# right X = $d * ceil($step/2)
#
# x_bottom_start = - y1 * step_left
# want x2 >= x_bottom_start
#      x2 >= - y1 * step_left
#      x2/step_left >= - y1
#      - x2/step_left <= y1
#      y1 >= - x2/step_left
#      y1 >= ceil(-x2/step_left)
#
# x_bottom_end = y1 * step_right
# want x1 <= x_bottom_end
#      x1 <= y1 * step_right
#      y1 * step_right >= x1
#      y1 >= ceil(x1/step_right)
#
# left N = (($step * $y1 - ($step-2))*$y1) / 2 + 1
# bottom_offset = $x1 - $y1 * $step_left
# N lo   = leftN + bottom_offset
#        = ((step * y1 - (step-2))*y1) / 2 + 1 + x1 - y1 * step_left
#        = ((step * y1 - (step-2)-2*step_left)*y1) / 2 + 1 + x1
# step_left = floor(step/2)
# 2*step_left = step - step&1
# N lo   = ((step * y1 - (step-2)-2*step_left)*y1) / 2 + 1 + x1

# exact
sub rect_to_n_range {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  ### PyramidRows rect_to_n_range(): "$x1,$y1, $x2,$y2  step=$self->{'step'}"

  $x1 = round_nearest ($x1);
  $y1 = round_nearest ($y1);
  $x2 = round_nearest ($x2);
  $y2 = round_nearest ($y2);
  if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); } # swap to y1<=y2
  if ($y2 < 0) {
    return (1, 0); # rect all negative, no N
  }
  if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); } # swap to x1<=x2

  my $left_slope = $self->{'left_slope'};
  my $right_slope = $self->{'right_slope'};

  my $x_top_right = $y2 * $right_slope;
  ### $x_top_right
  ### x_top_left: - $y2 * $left_slope

  # \    |    /
  #  \   |   /
  #   \  |  /  +-----    x_top_right > x1
  #    \ | /   |x1,y2
  #     \|/
  # -----+-----------
  #
  #       \    |    x_top_start = -y2*step_left
  # -----+ \   |      x_top_start < x2
  # x2,y2|  \  |
  #          \ | /
  #           \|/
  # -----------+--
  #
  if ($x1 > $x_top_right
      || $x2 < - $y2 * $left_slope) {
    ### rect all off to the left or right, no N ...
    return (1, 0);
  }

  ### x1 to x2 of top row y2 intersects some of the pyramid ...
  ### assert: $x2 >= -$y2*$left_slope
  ### assert: $x1 <= $y2*$right_slope

  # raise y1 to the lowest row of the rectangle which intersects some of the
  # pyramid
  $y1 = max ($y1,
             0,

             # for x2 >= x_bottom_left, round up
             $left_slope && int((-$x2+$left_slope-1)/$left_slope),

             # for x1 <= x_bottom_right, round up
             $right_slope && int(($x1+$right_slope-1)/$right_slope),
            );
  ### $y1
  ### y1 for bottom left: $left_slope && int((-$x2+$left_slope-1)/$left_slope)
  ### y1 for bottom right: $right_slope && int(($x1+$right_slope-1)/$right_slope)
  ### assert: $x2 >= -$y1*$left_slope
  ### assert: $x1 <= $y1*$right_slope

  return ($self->xy_to_n (max($x1, -$y1*$left_slope), $y1),
          $self->xy_to_n (min($x2, $x_top_right), $y2));


  # my $step = $self->{'step'};
  # my $sub = ($step&1) - 2;
  #
  # ### x bottom start: -$y1*$left_slope
  # ### x bottom end: $y1*$right_slope
  # ### $x1
  # ### $x2
  # ### bottom left x: max($x1, -$y1*$left_slope)
  # ### top right x: min ($x2, $x_top_end)
  # ### $y1
  # ### $y2
  # ### n_lo: (($step * $y1 - $sub)*$y1 + 2)/2 + max($x1, -$y1*$left_slope)
  # ### n_hi: (($step * $y2 - $sub)*$y2 + 2)/2 + min($x2, $x_top_end)
  #
  # ### assert: $y1-1==$y1 || (($step * $y1 - $sub)*$y1 + 2) == int (($step * $y1 - $sub)*$y1 + 2)
  # ### assert: $y2-1==$y2 || (($step * $y2 - $sub)*$y2 + 2) == int (($step * $y2 - $sub)*$y2 + 2)

  # (($step * $y1 - $sub)*$y1 + 2)/2
  #           + max($x1, -$y1*$left_slope),  # x_bottom_start
  #
  #           (($step * $y2 - $sub)*$y2 + 2)/2
  #           + min($x2, $x_top_end));
  #
  #   # return ($self->xy_to_n (max ($x1, -$y1*$left_slope), $y1),
  #   #         $self->xy_to_n (min ($x2, $x_top_end),      $y2));
}

1;
__END__