File Coverage

blib/lib/Math/NumSeq/ReReplace.pm

Criterion	Covered	Total	%
statement	49	53	92.4
branch	4	8	50.0
condition	4	9	44.4
subroutine	14	15	93.3
pod	5	5	100.0
total	76	90	84.4

# Copyright 2012, 2013, 2014 Kevin Ryde

# This file is part of Math-NumSeq.
#
# Math-NumSeq 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-NumSeq 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-NumSeq.  If not, see .



# Benoit Cloitre followups
# http://sci.tech-archive.net/Archive/sci.math.research/2004-10/0224.html
# http://sci.tech-archive.net/Archive/sci.math.research/2004-11/0015.html
# http://sci.tech-archive.net/Archive/sci.math.research/2004-11/0021.html
#


package Math::NumSeq::ReReplace;
use 5.004;
use strict;

use vars '$VERSION','@ISA';
$VERSION = 72;

use Math::NumSeq 7; # v.7 for _is_infinite()
@ISA = ('Math::NumSeq');
*_is_infinite = \&Math::NumSeq::_is_infinite;

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

# use constant name => Math::NumSeq::__('Repeated Replacement');
use constant description => Math::NumSeq::__('Sequence of repeated replacements.');
use constant values_min => 1;
sub values_max {
  my ($self) = @_;
  my $stage = $self->{'stage'};
  return ($stage < 0 ? undef : $stage+1);
}
use constant i_start => 1;
use constant characteristic_smaller => 1;
use constant characteristic_integer => 1;

use constant parameter_info_array =>
  [
   { name        => 'stage',
     share_key   => 'stage_neg1',
     type        => 'integer',
     default     => '-1',
     width       => 4,
     minimum     => -1,
     # description => Math::NumSeq::__('...'),
   },
  ];

#------------------------------------------------------------------------------
# 'A100002'
# 0  1  2  3  4  5  6  7  8  9
# 1, 2, 1, 2, 3, 3, 1, 2, 4, 4, 3, 4, 1, 2, 5, 5, 3, 5, 1, 2, 4, 5, 3, 4,
#             1  2        1  2

# cf A100287 - first occurrence of n
#    A101224
#
my @oeis_anum = ('A100002', # -1 all stages
                 # 0 all-ones, but A000012 has OFFSET=0
                 # 1 is 1,2 rep, but A040001 has OFFSET=0
                );
sub oeis_anum {
  my ($self) = @_;
  return $oeis_anum[$self->{'stage'}+1];
}

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

sub rewind {
  my ($self) = @_;
  $self->{'i'} = $self->i_start;
  my $count = $self->{'count'} = [undef, [], []];
}
sub next {
  my ($self) = @_;
  ### ReReplace next(): $self->{'i'}

  my $stage = $self->{'stage'};
  if ($stage == 0) {
    return ($self->{'i'}++,
            1);
  }

  my $count = $self->{'count'};
  ### $count

  my $value = 1;
  for my $level (2 .. $#$count) {
    ### $level
    ### $value
    ### count: ($count->[$level]->[$value]||0) + 1

    if (++$count->[$level]->[$value] >= $level) {
      $count->[$level]->[$value] = 0;
      $value = $level;
    }
  }

  if ($value >= $#$count-1
      && ($stage < 0 || $value < $stage)) {
    push @$count, [ @{$count->[-1]} ];  # array copy
    ### extended to: $count
  }

  ### return: $value
  return ($self->{'i'}++,
          $value);
}

sub pred {
  my ($self, $value) = @_;
  ### Runs pred(): $value

  return ($value >= 1
          && $value == int($value));
}

1;
__END__