File Coverage

blib/lib/Math/NumSeq/HafermanCarpet.pm

Criterion	Covered	Total	%
statement	71	79	89.8
branch	15	24	62.5
condition	7	16	43.7
subroutine	16	16	100.0
pod	2	2	100.0
total	111	137	81.0

# Copyright 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::HafermanCarpet;
use 5.004;
use strict;

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

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

use Math::NumSeq::Repdigits;
*_digit_split_lowtohigh = \&Math::NumSeq::Repdigits::_digit_split_lowtohigh;

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


use constant description => Math::NumSeq::__('Flattened Haferman carpet.');
use constant default_i_start => 0;
use constant values_min => 0;
use constant values_max => 1;
use constant characteristic_integer => 1;
use constant characteristic_smaller => 1;

# 000 all zeros
# 001 infs are box fractal
# 010 evens  is plain starting from 1
# 011      odd=1 even=0 inf=0  is inverse of plain
# 100 odds odd=0 even=1 inf=1  is plain starting from 0
# 101 inverse of evens
# 110 inverse of infs box fractal
# 111 all ones

# start0     carpet 0
# start0 inv carpet 0 inverse
# start1     carpet 1
# start1 inv carpet 1 inverse
# box
# box inverse

use constant parameter_info_array =>
  [
   # { name    => 'haferman_type',
   #   display => Math::NumSeq::__('Type'),
   #   type    => 'enum',
   #   default => 'array',
   #   choices => ['array','alt','side'],
   # },
   { name    => 'initial_value',
     display => Math::NumSeq::__('Initial'),
     type    => 'integer',
     default => 0,
     minimum => 0,
     maximum => 1,
     width   => 1,
   },
   { name    => 'inverse',
     display => Math::NumSeq::__('Inverse'),
     type    => 'boolean',
     default => 0,
   },
   # { name        => 'radix',
   #   share_key   => 'radix_3',
   #   type        => 'integer',
   #   display     => Math::NumSeq::__('Radix'),
   #   default     => 3,
   #   minimum     => 2,
   #   width       => 3,
   #   description => Math::NumSeq::__('Radix, ie. base, for the values calculation.  Default is base 3.'),
   # },
  ];

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

# 000 all zeros
# 001 infs are box fractal
# 010 evens inverse of starting from 1
# 011      odd=1 even=0 inf=0  is inverse of plain
# 100 odds odd=0 even=1 inf=1  is plain starting from 0
# 101                          is plain starting from 1
# 110 inverse of infs box fractal
# 111 all ones
#
# my %odd_by_type  = (start0 => 1,
#                     start1 => 1,
#                     box    => 0);
# my %inf_by_type  = (start0 => 0,
#                     start1 => 1,
#                     box    => 1);
sub ith {
  my ($self, $i) = @_;
  ### ith(): $i

  if ($i < 0 || _is_infinite($i)) {  # don't loop forever if $i is +infinity
    return undef;
  }

  my $haferman_type = $self->{'haferman_type'} || 'array';
  my $radix = $self->{'radix'} || 3;
  my $two_digits;
  if ($haferman_type eq 'array') {
    if ($radix & 1) {
      $radix *= $radix;
    } else {
      $two_digits = 1;
    }
  } else {
    $two_digits = ($haferman_type eq 'alt');
  }

  my $value = 0;  # position even or odd
  for (;;) {
    if ($i) {
      my $digit = _divrem_mutate($i,$radix);
      if ($two_digits) {
        my $digit2 = _divrem_mutate($i,$radix);
        if ($haferman_type eq 'array') {
          $digit += $digit2;
        }
      }
      if ($digit & 1) {
        # stop at odd digit
        if ($value) {
          $value = 0;  # even position value=0 always
        } else {
          $value = ($haferman_type eq 'box' ? 0 : 1);
        }
        last;
      } else {
        # step position across even digit
        $value ^= 1;
      }
    } else {
      # no more digits, all even, no odd
      $value = $self->{'initial_value'};
      last;
    }
  }
  if ($self->{'inverse'}) {
    $value ^= 1;
  }
  return $value;
}

sub pred {
  my ($self, $value) = @_;
  return ($value == 0 || $value == 1);
}

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

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