File Coverage

blib/lib/Math/PlanePath.pm

Criterion	Covered	Total	%
statement	243	352	69.0
branch	39	108	36.1
condition	19	88	21.5
subroutine	74	94	78.7
pod	40	41	97.5
total	415	683	60.7

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

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

use vars '$VERSION';
$VERSION = 128;

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


# defaults
use constant figure => 'square';
use constant default_n_start => 1;
sub n_start {
  my ($self) = @_;
  if (ref $self && defined $self->{'n_start'}) {
    return $self->{'n_start'};
  } else {
    return $self->default_n_start;
  }
}
sub arms_count {
  my ($self) = @_;
  return $self->{'arms'} || 1;
}

use constant class_x_negative => 1;
use constant class_y_negative => 1;
sub x_negative { $_[0]->class_x_negative }
sub y_negative { $_[0]->class_y_negative }
use constant x_negative_at_n => undef;
use constant y_negative_at_n => undef;
use constant n_frac_discontinuity => undef;

use constant parameter_info_array => [];
sub parameter_info_list {
  return @{$_[0]->parameter_info_array};
}

# x_negative(),y_negative() existed before x_minimum(),y_minimum(), so
# default x_minimum(),y_minimum() from those.
sub x_minimum {
  my ($self) = @_;
  return ($self->x_negative ? undef : 0);
}
sub y_minimum {
  my ($self) = @_;
  return ($self->y_negative ? undef : 0);
}
use constant x_maximum => undef;
use constant y_maximum => undef;

sub sumxy_minimum {
  my ($self) = @_;
  ### PlanePath sumxy_minimum() ...
  if (defined (my $x_minimum = $self->x_minimum)
      && defined (my $y_minimum = $self->y_minimum)) {
    ### $x_minimum
    ### $y_minimum
    return $x_minimum + $y_minimum;
  }
  return undef;
}
use constant sumxy_maximum => undef;

sub sumabsxy_minimum {
  my ($self) = @_;
  my $x_minimum = $self->x_minimum;
  my $y_minimum = $self->y_minimum;
  if (defined $x_minimum && $x_minimum >= 0
      && defined $y_minimum && $y_minimum >= 0) {
    # X>=0 and Y>=0 so abs(X)+abs(Y) == X+Y
    return $self->sumxy_minimum;
  }
  return _max($x_minimum||0,0) + _max($y_minimum||0,0);
}
use constant sumabsxy_maximum => undef;

use constant diffxy_minimum => undef;
#
# If the path is confined to the fourth quadrant, so X>=something and
# Y<=something then a minimum X-Y exists.  But fourth-quadrant-only path is
# unusual, so don't bother with code checking that.
# sub diffxy_minimum {
#   my ($self) = @_;
#   if (defined (my $y_maximum = $self->y_maximum)
#       && defined (my $x_minimum = $self->x_minimum)) {
#     return $x_minimum - $y_maximum;
#   } else {
#     return undef;
#   }
# }

# If the path is confined to the second quadrant, so X<=something and
# Y>=something, then has a maximum X-Y.  Presume that the x_maximum() and
# y_minimum() occur together.
#
sub diffxy_maximum {
  my ($self) = @_;
  if (defined (my $y_minimum = $self->y_minimum)
      && defined (my $x_max = $self->x_maximum)) {
    return $x_max - $y_minimum;
  } else {
    return undef;
  }
}

# absdiffxy = abs(X-Y)
sub absdiffxy_minimum {
  my ($self) = @_;
  # if X-Y all one sign, so X-Y>=0 or X-Y<=0, then abs(X-Y) from that
  my $m;
  if (defined($m = $self->diffxy_minimum) && $m >= 0) {
    return $m;
  }
  if (defined($m = $self->diffxy_maximum) && $m <= 0) {
    return - $m;
  }
  return 0;
}
sub absdiffxy_maximum {
  my ($self) = @_;
  # if X-Y constrained so min<=X-Y<=max then max abs(X-Y) one of the two ends
  if (defined (my $min = $self->diffxy_minimum)
      && defined (my $max = $self->diffxy_maximum)) {
    return _max(abs($min),abs($max));
  }
  return undef;
}


# experimental default from x_minimum(),y_minimum()
# FIXME: should use absx_minimum, absy_minimum, for paths outside first quadrant
sub rsquared_minimum {
  my ($self) = @_;

  # The X and Y each closest to the origin.  This assumes that point is
  # actually visited, but is likely to be close.
  my $x_minimum = $self->x_minimum;
  my $x_maximum = $self->x_maximum;
  my $y_minimum = $self->y_minimum;
  my $y_maximum = $self->y_maximum;
  my $x = ((  defined $x_minimum && $x_minimum) > 0 ? $x_minimum
           : (defined $x_maximum && $x_maximum) < 0 ? $x_maximum
           : 0);
  my $y = ((  defined $y_minimum && $y_minimum) > 0 ? $y_minimum
           : (defined $y_maximum && $y_maximum) < 0 ? $y_maximum
           : 0);
  return ($x*$x + $y*$y);

  # # Maybe initial point $self->n_to_xy($self->n_start)) as the default,
  # # but that's not the minimum on "wider" paths.
  # return 0;
}
use constant rsquared_maximum => undef;

sub gcdxy_minimum {
  my ($self) = @_;
  ### gcdxy_minimum(): "visited=".($self->xy_is_visited(0,0)||0)
  return ($self->xy_is_visited(0,0)
          ? 0   # gcd(0,0)=0
          : 1); # any other has gcd>=1
}
use constant gcdxy_maximum => undef;

use constant turn_any_left     => 1;
use constant turn_any_right    => 1;
use constant turn_any_straight => 1;


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

use constant dir_minimum_dxdy => (1,0);   # East
use constant dir_maximum_dxdy => (0,0);   # supremum all angles

use constant dx_minimum => undef;
use constant dy_minimum => undef;
use constant dx_maximum => undef;
use constant dy_maximum => undef;
#
# =item C<$n = $path-E_UNDOCUMENTED__dxdy_list_at_n()>
#
# Return the N at which all possible dX,dY will have been seen.  If there is
# not a finite set of possible dX,dY steps then return C.
#
use constant 1.02;
use constant _UNDOCUMENTED__dxdy_list => ();  # default empty for not a finite list
use constant _UNDOCUMENTED__dxdy_list_at_n => undef; # maybe dxdy_at_n()
use constant _UNDOCUMENTED__dxdy_list_three => (2,0,    # E
                                                -1,1,   # NW
                                                -1,-1); # SW
use constant _UNDOCUMENTED__dxdy_list_six => (2,0,   # E
                                              1,1,   # NE
                                              -1,1,  # NW
                                              -2,0,  # W
                                              -1,-1, # SW
                                              1,-1); # SE
use constant _UNDOCUMENTED__dxdy_list_eight => (1,0,   # E
                                                1,1,   # NE
                                                0,1,   # N
                                                -1,1,  # NW
                                                -1,0,  # W
                                                -1,-1, # SW
                                                0,-1,  # S
                                                1,-1); # SE

sub absdx_minimum {
  my ($self) = @_;
  # If dX>=0 then abs(dX)=dX always and absdx_minimum()==dx_minimum().
  # This happens for column style paths like CoprimeColumns.
  # dX>0 is only for line paths so not very interesting.
  if (defined (my $dx_minimum = $self->dx_minimum)) {
    if ($dx_minimum >= 0) { return $dx_minimum; }
  }
  return 0;
}
sub absdx_maximum {
  my ($self) = @_;
  if (defined (my $dx_minimum = $self->dx_minimum)
      && defined (my $dx_maximum = $self->dx_maximum)) {
    return _max(abs($dx_minimum),abs($dx_maximum));
  }
  return undef;
}

sub absdy_minimum {
  my ($self) = @_;
  # if dY>=0 then abs(dY)=dY always and absdy_minimum()==dy_minimum()
  if (defined (my $dy_minimum = $self->dy_minimum)) {
    if ($dy_minimum >= 0) { return $dy_minimum; }
  }
  return 0;
}
sub absdy_maximum {
  my ($self) = @_;
  if (defined (my $dy_minimum = $self->dy_minimum)
      && defined (my $dy_maximum = $self->dy_maximum)) {
    return _max(abs($dy_minimum),abs($dy_maximum));
  } else {
    return undef;
  }
}

use constant dsumxy_minimum => undef;
use constant dsumxy_maximum => undef;
use constant ddiffxy_minimum => undef;
use constant ddiffxy_maximum => undef;

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

sub new {
  my $class = shift;
  return bless { @_ }, $class;
}

{
  my %parameter_info_hash;
  sub parameter_info_hash {
    my ($class_or_self) = @_;
    my $class = (ref $class_or_self || $class_or_self);
    return ($parameter_info_hash{$class}
            ||= { map { $_->{'name'} => $_ }
                  $class_or_self->parameter_info_list });
  }
}

sub xy_to_n_list {
  ### xy_to_n_list() ...
  if (defined (my $n = shift->xy_to_n(@_))) {
    ### $n
    return $n;
  }
  ### empty ...
  return;
}
sub xy_is_visited {
  my ($self, $x, $y) = @_;
  ### xy_is_visited(): "$x,$y is ndefined=".defined($self->xy_to_n($x,$y))
  return defined($self->xy_to_n($x,$y));
}

sub n_to_n_list {
  my ($self, $n) = @_;
  my ($x,$y) = $self->n_to_xy($n) or return;
  return $self->xy_to_n_list($x,$y);
}

sub n_to_dxdy {
  my ($self, $n) = @_;
  ### n_to_dxdy(): $n
  my ($x,$y) = $self->n_to_xy ($n)
    or return;
  my ($next_x,$next_y) = $self->n_to_xy ($n + $self->arms_count)
    or return;
  ### points: "$x,$y  $next_x,$next_y"
  return ($next_x - $x,
          $next_y - $y);
}
sub n_to_rsquared {
  my ($self, $n) = @_;
  my ($x,$y) = $self->n_to_xy($n) or return undef;
  return $x*$x + $y*$y;
}
sub n_to_radius {
  my ($self, $n) = @_;
  my $rsquared = $self->n_to_rsquared($n);
  return (defined $rsquared ? sqrt($rsquared) : undef);
}

sub xyxy_to_n_list {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  my @n1 = $self->xy_to_n_list($x1,$y1) or return;
  my @n2 = $self->xy_to_n_list($x2,$y2) or return;
  my $arms = $self->arms_count;
  return grep { my $want_n2 = $_ + $arms;
                grep {$_ == $want_n2} @n2  # seek $n2 which is this $n1+$arms
              } @n1;
}
sub xyxy_to_n {
  my $self = shift;
  my @n_list = $self->xyxy_to_n_list(@_);
  return $n_list[0];
}

sub xyxy_to_n_list_either {
  my ($self, $x1,$y1, $x2,$y2) = @_;
  my @n1 = $self->xy_to_n_list($x1,$y1) or return;
  my @n2 = $self->xy_to_n_list($x2,$y2) or return;
  my $arms = $self->arms_count;
  my @n_list;
  foreach my $n1 (@n1) {
    foreach my $n2 (@n2) {
      if (abs($n1 - $n2) == $arms) {
        push @n_list, _min($n1,$n2);
      }
    }
  }
  @n_list = sort {$a<=>$b} @n_list;
  return @n_list;
}
sub xyxy_to_n_either {
  my $self = shift;
  my @n_list = $self->xyxy_to_n_list_either(@_);
  return $n_list[0];
}

#------------------------------------------------------------------------------
# turns

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

  my ($dx,$dy) = $self->n_to_dxdy($n - $self->arms_count)
    or return undef;
  my ($next_dx,$next_dy) = $self->n_to_dxdy($n)
    or return undef;

  ### dxdy: "$dx,$dy and $next_dx,$next_dy  arms=".$self->arms_count

  return (($next_dy * $dx <=> $next_dx * $dy) || 0);  # 1,0,-1
}

#------------------------------------------------------------------------------
# tree

sub is_tree {
  my ($self) = @_;
  return $self->tree_n_num_children($self->n_start);
}

use constant tree_n_parent => undef;  # default always no parent

use constant tree_n_children => ();   # default no children
sub tree_n_num_children {
  my ($self, $n) = @_;
  if ($n >= $self->n_start) {
    my @n_list = $self->tree_n_children($n);
    return scalar(@n_list);
  } else {
    return undef;
  }
}

# For non-trees n_num_children() always returns 0 so that's the single
# return here.
use constant tree_num_children_list => (0);
sub tree_num_children_minimum {
  my ($self) = @_;
  return ($self->tree_num_children_list)[0];
}
sub tree_num_children_maximum {
  my ($self) = @_;
  return ($self->tree_num_children_list)[-1];
}
sub tree_any_leaf {
  my ($self) = @_;
  return ($self->tree_num_children_minimum == 0);
}

use constant tree_n_to_subheight => 0; # default all leaf node

use constant tree_n_to_depth => undef;
use constant tree_depth_to_n => undef;
sub tree_depth_to_n_end {
  my ($self, $depth) = @_;
  if ($depth >= 0
      && defined (my $n = $self->tree_depth_to_n($depth+1))) {
    ### tree_depth_to_n_end(): $depth, $n
    return $n-1;
  } else {
    return undef;
  }
}
sub tree_depth_to_n_range {
  my ($self, $depth) = @_;
  if (defined (my $n = $self->tree_depth_to_n($depth))
      && defined (my $n_end = $self->tree_depth_to_n_end($depth))) {
    return ($n, $n_end);
  }
  return;
}

sub tree_depth_to_width {
  my ($self, $depth) = @_;
  if (defined (my $n = $self->tree_depth_to_n($depth))
      && defined (my $n_end = $self->tree_depth_to_n_end($depth))) {
    return $n_end - $n + 1;
  }
  return undef;
}

sub tree_num_roots {
  my ($self) = @_;
  my @root_n_list = $self->tree_root_n_list;
  return scalar(@root_n_list);
}
sub tree_root_n_list {
  my ($self) = @_;
  my $n_start = $self->n_start;
  my @ret;
  for (my $n = $n_start; ; $n++) {
    # stop on finding a non-root (has a parent), or a non-tree path has no
    # children at all
    if (defined($self->tree_n_parent($n))
        || ! $self->tree_n_num_children($n)) {
      last;
    }
    push @ret, $n;
  }
  return @ret;
}

# Generic search upwards.  Not fast, but works with past Toothpick or
# anything slack which doesn't have own tree_n_root().  When only one root
# there's no search.
sub tree_n_root {
  my ($self, $n) = @_;
  my $num_roots = $self->tree_num_roots;
  if ($num_roots == 0) {
    return undef;  # not a tree
  }
  my $n_start = $self->n_start;
  unless ($n >= $n_start) {  # and warn if $n==undef
    return undef;  # -inf or NaN
  }
  if ($num_roots == 1) {
    return $n_start;  # only one root, no search
  }

  for (;;) {
    my $n_parent = $self->tree_n_parent($n);
    if (! defined $n_parent) {
      return $n; # found root
    }
    unless ($n_parent < $n) {
      return undef;  # +inf or something bad not making progress
    }
    $n = $n_parent;
  }
}

# Generic search for where no more children.
# But must watch out for infinite lets, and might also watch out for
# rounding or overflow.
#
# sub path_tree_n_to_subheight {
#   my ($path, $n) = @_;
#   ### path_tree_n_to_subheight(): "$n"
#
#   if (is_infinite($n)) {
#     return $n;
#   }
#   my $max = $path->tree_n_to_depth($n) + 10;
#   my @n = ($n);
#   my $height = 0;
#   do {
#     @n = map {$path->tree_n_children($_)} @n
#       or return $height;
#     $height++;
#   } while (@n && $height < $max);
#
#   ### height infinite ...
#   return undef;
# }

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

use constant level_to_n_range => ();
use constant n_to_level => undef;


#------------------------------------------------------------------------------
# shared undocumented internals

sub _max {
  my $max = 0;
  foreach my $i (1 .. $#_) {
    if ($_[$i] > $_[$max]) {
      $max = $i;
    }
  }
  return $_[$max];
}
sub _min {
  my $min = 0;
  foreach my $i (1 .. $#_) {
    if ($_[$i] < $_[$min]) {
      $min = $i;
    }
  }
  return $_[$min];
}
# Return square root of $x, rounded towards zero.
# Recent BigFloat and BigRat need explicit conversion to BigInt, they no
# longer do that in int().
sub _sqrtint {
  my ($x) = @_;
  if (ref $x) {
    if ($x->isa('Math::BigFloat') || $x->isa('Math::BigRat')) {
      $x = $x->copy->as_int;
    }
  }
  return int(sqrt($x));
}

use Math::PlanePath::Base::Generic 'round_nearest';
sub _rect_for_first_quadrant {
  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;
  if ($x2 < 0 || $y2 < 0) {
    return;
  }
  return ($x1,$y1, $x2,$y2);
}

# return ($quotient, $remainder)
sub _divrem {
  my ($n, $d) = @_;
  if (ref $n && $n->isa('Math::BigInt')) {
    my ($quot,$rem) = $n->copy->bdiv($d);
    if (! ref $d || $d < 1_000_000) {
      $rem = $rem->numify;  # plain remainder if fits
    }
    return ($quot, $rem);
  }
  my $rem = $n % $d;
  return (int(($n-$rem)/$d), # exact division stays in UV
          $rem);
}

# return $remainder, modify $n
# the scalar $_[0] is modified, but if it's a BigInt then a new BigInt is made
# and stored there, the bigint value is not changed
sub _divrem_mutate {
  my $d = $_[1];
  my $rem;
  if (ref $_[0] && $_[0]->isa('Math::BigInt')) {
    ($_[0], $rem) = $_[0]->copy->bdiv($d);  # quot,rem in array context
    if (! ref $d || $d < 1_000_000) {
      return $rem->numify;  # plain remainder if fits
    }
  } else {
    $rem = $_[0] % $d;
    $_[0] = int(($_[0]-$rem)/$d); # exact division stays in UV
  }
  return $rem;
}

1;
__END__