File Coverage

blib/lib/Math/NumSeq/UndulatingNumbers.pm

Criterion	Covered	Total	%
statement	135	138	97.8
branch	52	56	92.8
condition	21	23	91.3
subroutine	18	18	100.0
pod	6	6	100.0
total	232	241	96.2

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


# http://mathworld.wolfram.com/UndulatingNumber.html

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

use vars '$VERSION', '@ISA';
$VERSION = 71;
use Math::NumSeq;
@ISA = ('Math::NumSeq');
*_is_infinite = \&Math::NumSeq::_is_infinite;

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


# use constant name => Math::NumSeq::__('Undulating Numbers');
use constant description => Math::NumSeq::__('Numbers like 37373 which are a pattern of digits ABAB...');
use constant default_i_start => 0;
use constant characteristic_increasing => 1;
use constant characteristic_integer => 1;
use constant values_min => 0;

use Math::NumSeq::Base::Digits;
use constant parameter_info_array =>
  [
   Math::NumSeq::Base::Digits::parameter_common_radix(),
   { name        => 'including_repdigits',
     type        => 'boolean',
     display     => Math::NumSeq::__('Repdigits'),
     default     => 1,
     description => Math::NumSeq::__('Whether to include repdigits A=B.'),
   },
  ];

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

# cf A046075 - decimal A!=B and min length 3
#    A033619 - decimal A=B any length
#
#    A046076 - "binary undulants", numbers k where 2^k written in decimal
#              has an 010 or 101 somewhere
#
my @oeis_anum;

$oeis_anum[1]->[2]  = 'A000975'; # binary A!=B no consecutive equal bits
# OEIS-Catalogue: A000975 radix=2 including_repdigits=0

# $oeis_anum[0]->[10] = 'A033619'; # decimal incl A=B, but OFFSET=1 value=0
# # OEIS-Catalogue: A033619 including_repdigits=1

sub oeis_anum {
  my ($self) = @_;
  return $oeis_anum[!$self->{'including_repdigits'}]->[$self->{'radix'}];
}

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

sub rewind {
  my ($self) = @_;
  my $radix = $self->{'radix'};
  if ($radix < 2) { $radix = 10; }
  $self->{'radix'} = $radix;

  $self->{'i'}        = 0;
  $self->{'value'}    = -1;
  $self->{'inc'}      = 1;   # 10101010 or 101010101
  $self->{'inc_even'} = 0;   # 1 if inc=10101010 or 0 if inc=101010101
  $self->{'a'}        = 0;   # 1 to 9, or 0 for initial smalls
  $self->{'b'}        = 0;   # 0 to 9, perhaps skipping a==b
}

sub next {
  my ($self) = @_;
  ### UndulatingNumbers next() ...
  ### inc: $self->{'inc'}
  ### value: $self->{'value'}

  my $radix = $self->{'radix'};
  my $value;
  if ($value = ($self->{'value'} += $self->{'inc'})) {
    $self->{'b'}++;
    ### value: $self->{'value'}
    ### a: $self->{'a'}
    ### b: $self->{'b'}

    if (! $self->{'including_repdigits'}
        && $self->{'b'} == $self->{'a'}) {
      $self->{'value'} = ($value += $self->{'inc'});
      $self->{'b'}++;

      ### no repdigits, skip a==b to new b: $self->{'b'}
      ### value now: $value
    }

    if ($self->{'b'} >= $radix ) {
      ### b overflow, a inc ...
      ### inc_even: $self->{'inc_even'}

      # a9a + 10 -> (a+1)0(a)
      # if inc=10..10 ends in 0 then need 1 extra to give (a+1)0(a+1)

      $self->{'b'} = 0;
      $self->{'value'} = ($value += $self->{'inc_even'});
      ### value now: $value

      if (++$self->{'a'} >= $radix) {
        ### a overflow, next length ...

        # inc=101 -> 1010    inc_even=0
        # or 1010 -> 10101   inc_even=0
        my $inc_even = ($self->{'inc_even'} ^= 1);
        $self->{'inc'} = $self->{'inc'} * $radix + !$inc_even;
        $self->{'a'} = 1;
        $self->{'value'} = ($value += $inc_even);

        ### lengthen to inc: $self->{'inc'}
        ### n now: $value
      }
    }
  }
  return ($self->{'i'}++, $value);
}

# A is 0 to 9 = 10 values
# AB is 10 to 99 = 90 values
# total R*R
# then high AB is 10 to 99 = 90 values
# total 90 = (R-1)*R
# R=2 total 2*2-1=3 1,10,11
#
# or without repdigits
# AB skips 11, ..., 99 = 10 values
# total R*R - R = R*(R-1)
#
sub ith {
  my ($self, $i) = @_;
  ### UndulatingNumbers ith(): $i
  my $radix = $self->{'radix'};
  my $rdec = $radix - 1;

  if ($i < 0) {
    return undef;
  }

  my $including_repdigits = $self->{'including_repdigits'};

  my $pair_step = ($including_repdigits ? $radix*$radix : $radix*$rdec+1);
  ### small pair_step: $pair_step

  if ($i < $pair_step || _is_infinite($i)) {
    ### below small pairs ...

    # at i=11 skip to value=12
    #    i=19         value=20
    #    i=20         value=21
    #    i=21 skip to value=23
    #
    if (! $including_repdigits && $i > $radix) {
      $i += int(($i-1)/$radix); # skip 11,22,33 etc
    }
    return $i;
  }

  $i -= $pair_step;
  ### i remainder: $i

  $pair_step = $rdec*($including_repdigits ? $radix : $rdec);
  ### decreased pair_step: $pair_step

  my $i_pair = $i % $pair_step;
  my $i_len = int($i/$pair_step);
  ### $i_pair
  ### $i_len

  my ($a, $b);
  if ($including_repdigits) {
    $a = int($i_pair/$radix) + 1;
    $b = $i_pair % $radix;
  } else {
    $a = int($i_pair/$rdec) + 1;
    $b = $i_pair % $rdec;
    $b += ($b >= $a);
  }
  ### $a
  ### $b

  my $ret = $a*$radix + $b;
  ### $ret
  while ($i_len-- >= 0) {
    $ret = ($ret * $radix) + $a;
    ### append A to: $ret

    last unless $i_len-- >= 0;
    $ret = ($ret * $radix) + $b;
    ### append B to: $ret
  }

  ### $ret
  return $ret;
}

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

  if (_is_infinite($value)) {
    return undef;
  }
  if ($value != int($value)) {
    return 0;
  }

  my $radix = $self->{'radix'};
  my $a = $value % $radix;
  if ($value = int($value/$radix)) {
    my $b = $value % $radix;
    if (! $self->{'including_repdigits'}
        && $a == $b) {
      return 0;
    }

    while ($value = int($value/$radix)) {
      if (($value % $radix) != $a) { return 0; }

      $value = int($value/$radix) || last;
      if (($value % $radix) != $b) { return 0; }
    }
  }
  return 1;
}

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

  if ($value <= 0) {
    return 0;
  }
  if (_is_infinite($value)) {
    return $value;
  }

  my $radix = $self->{'radix'};
  my @digits = _digit_split(int($value), $radix);

  my $a = pop @digits;
  @digits or return $a;  # one digit only

  my $including_repdigits = $self->{'including_repdigits'};
  my $rdec = $radix - 1;

  my $b = pop @digits;
  ### $a
  ### $b
  ### $including_repdigits
  ### digit count: scalar(@digits)
  ### $radix
  ### $rdec

  my $i = $a * ($including_repdigits ? $radix : $rdec) + $b
    + ($including_repdigits || $a < $b ? 0 : 1)
    + scalar(@digits) * $rdec*($including_repdigits ? $radix : $rdec);
  ### $i

  # see if the value is in fact smaller than ABABAB...
  # if !repdigits and have a=b then it's bigger

  if (! $including_repdigits && $a == $b) {
    ### repdigits when a=b ...
    return $i-1;
  }

  if ($including_repdigits
      || $a != $b) {

    while (@digits) {
      if ((my $c = pop @digits) != $a) {  # found different than ABABAB...
        if ($c < $a) { $i -= 1; }
        return $i;
      }
      ($a,$b) = ($b,$a);
    }
  }
  # value is either ABAB exactly, or something bigger
  return $i;
}
*value_to_i_estimate = \&value_to_i_floor;


sub _digit_split {
  my ($n, $radix) = @_;
  ### _digit_split(): $n
  my @ret;
  while ($n) {
    push @ret, $n % $radix;
    $n = int($n/$radix);
  }
  return @ret;   # low to high
}

1;
__END__