File Coverage

blib/lib/Math/NumSeq/FibbinaryBitCount.pm

Criterion	Covered	Total	%
statement	67	72	93.0
branch	11	16	68.7
condition	1	3	33.3
subroutine	15	15	100.0
pod	4	4	100.0
total	98	110	89.0

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


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

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

use Math::NumSeq;
use Math::NumSeq::Base::IterateIth;
@ISA = ('Math::NumSeq::Base::IterateIth',
        'Math::NumSeq');
*_is_infinite = \&Math::NumSeq::_is_infinite;


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

# use constant name => Math::NumSeq::__('Fibbinary Bit Count');
use constant description => Math::NumSeq::__('Bit count of fibbinary numbers (the numbers without adjacent 1 bits).');
use constant default_i_start => 0; # same as Fibbinary.pm
use constant characteristic_increasing => 0;
use constant characteristic_count => 1;
use constant characteristic_smaller => 1;

use constant parameter_info_array =>
  [ { name      => 'digit',
      display   => Math::NumSeq::__('Digit'),
      share_key => 'digit_1_0_00',
      type      => 'enum',
      default   => '1',
      choices   => ['1','0','00'],
      description => Math::NumSeq::__('What digit to count.'),
    },
  ];

sub values_min {
  my ($self) = @_;
  if ($self->{'digit'} eq 'all') {
    return $self->ith($self->i_start);
  } else {
    return 0;
  }
}

#------------------------------------------------------------------------------
# cf A027941 new highest bit count positions, being Fibonacci(2i+1)-1
#    A095111 bit count parity, 1/0
#    A020908 bit count of 2^k
#
#    A072649 n occurs Fibonacci(n) times
#             is fibbinary bit length
#    A130233 maximum index k for which F(k) <= n, fibbinary length + 1
#    A131234 1 then n occurs Fib(n) times
#             is length(Zeck)+1
#    A049839 max in row of Euclidean steps table A049837
#
#
my %oeis_anum = (1    => 'A007895', # fibbinary 1-bit count
                 0    => 'A102364',
                 '00' => 'A212278', # count "00" adjacent, possibly overlapping
                 all  => 'A072649',
                 # OEIS-Catalogue: A007895
                 # OEIS-Catalogue: A102364 digit=0
                 # OEIS-Catalogue: A212278 digit=00
                 # OEIS-Catalogue: A072649 digit=all i_start=1
                );
sub oeis_anum {
  my ($self) = @_;
  return $oeis_anum{$self->{'digit'}};
}

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

sub ith {
  my ($self, $i) = @_;
  ### FibbinaryBitCount ith(): $i

  if (_is_infinite($i)) {
    return $i;
  }

  # f1+f0 > i
  # f0 > i-f1
  # check i-f1 as the stopping point, so that if i=UV_MAX then won't
  # overflow a UV trying to get to f1>=i
  #
  my @fibs;
  {
    my $f0 = ($i * 0);  # inherit bignum 0
    my $f1 = $f0 + 1;   # inherit bignum 1
    while ($f0 <= $i-$f1) {
      ($f1,$f0) = ($f1+$f0,$f1);
      push @fibs, $f1;
    }
  }
  ### @fibs

  my $digit = $self->{'digit'};
  if ($digit eq 'all') {
    return scalar(@fibs);
  }

  my $ones = 0;
  my $onezeros = 0;
  my $sepzeros = 0;
  while (my $f = pop @fibs) {
    ### at: "$f  i=$i"
    if ($i >= $f) {
      $ones++;
      $i -= $f;
      ### sub: "$f to i=$i"

      # never consecutive fibs, so pop without comparing to i
      if (pop @fibs) {
        $onezeros++;
      }
      unless ($i) {
        ### stop at i=0 ...
        $sepzeros += scalar(@fibs);
        last;
      }
    } else {
      $sepzeros++;
    }
  }
  ### $ones
  ### $onezeros
  ### $sepzeros

  if ($digit eq '0') {
    return $sepzeros + $onezeros;
  }
  if ($digit eq '00') {
    return $sepzeros;
  }
  return $ones;
}

sub pred {
  my ($self, $value) = @_;
  return ($value >= 0 && $value == int($value));
}

1;
__END__