# Copyright 2010 Kevin Ryde

# This file is part of Math-Aronson.
#
# Math-Aronson 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-Aronson 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-Aronson.  If not, see <http://www.gnu.org/licenses/>.

package Math::Aronson;
use 5.004;
use strict;
use warnings;
use Carp;

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

use vars '$VERSION';
$VERSION = 1;

my $unaccent;
BEGIN {
  if (eval "use Unicode::Normalize 'normalize'; 1") {
    $unaccent = sub {
      ### unaccent: $_[0]
      # uncombine the latin-1 etc equivs then strip the zero-width marks
      ($_[0] = normalize('D',$_[0])) =~ s/\pM+//g
      };
  } else {
    $unaccent = sub {
      # latin-1, generated by devel/unaccent.pl
      $_[0] =~ tr/\x{C0}\x{C1}\x{C2}\x{C3}\x{C4}\x{C5}\x{C7}\x{C8}\x{C9}\x{CA}\x{CB}\x{CC}\x{CD}\x{CE}\x{CF}\x{D1}\x{D2}\x{D3}\x{D4}\x{D5}\x{D6}\x{D9}\x{DA}\x{DB}\x{DC}\x{DD}\x{E0}\x{E1}\x{E2}\x{E3}\x{E4}\x{E5}\x{E7}\x{E8}\x{E9}\x{EA}\x{EB}\x{EC}\x{ED}\x{EE}\x{EF}\x{F1}\x{F2}\x{F3}\x{F4}\x{F5}\x{F6}\x{F9}\x{FA}\x{FB}\x{FC}\x{FD}\x{FF}/AAAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy/;
    };
  }
}
#       $_[0] =~ s{([^[:ascii:]])}
#                 { my $c = $1;
#                   my $nfd = Unicode::Normalize::normalize('D',$c);
#                   ($nfd =~ /^([[:ascii:]])/ ? $1 : $c)
#                 }ge;

sub new {
  my $class = shift;
  my @ret;
  my $self = bless { ret   => \@ret,
                     queue => [ ],
                     lang  => 'en',
                     @_
                   }, $class;

  my $lang = delete $self->{'lang'};
  if ($lang eq 'fr') {
    %$self = (initial_string => 'e est la',
              conjunctions_word => 'et',
              %$self);
  } elsif ($lang eq 'en') {
    %$self = (initial_string => 't is the',
              conjunctions_word => 'and',
              %$self);
  }

  $self->{'ordinal_func'} ||=
    ($lang eq 'en' ? do {
      require Lingua::EN::Numbers;
      Lingua::EN::Numbers->VERSION(1.01);  # 1.01 rewrite
      \&Lingua::EN::Numbers::num2en_ordinal
    }
     : $lang eq 'fr' ? do {
       require Lingua::FR::Numbers;
       \&_fr_ordinal
     }
     : do {
       require Lingua::Any::Numbers;
       sub {
         return Lingua::Any::Numbers::to_ordinal($_[0], $lang);
       }
     });

  my $without_conjunctions = delete $self->{'without_conjunctions'};
  my $conjunctions_word    = delete $self->{'conjunctions_word'};
  my $without_conjunctions_func
    = $self->{'without_conjunctions_func'}
      = ($without_conjunctions && defined $conjunctions_word
         ? do {
           $conjunctions_word = lc($conjunctions_word);
           sub { $_[0] =~ s/\b\Q$conjunctions_word\E\b// }
         }
         : \&_conjunctions_noop);  # no change to strings

  my $str = delete $self->{'initial_string'};
  if (! defined $str) {
    croak 'No initial_string';
  }
  &$unaccent ($str);
  $str = lc ($str);

  my $letter = $self->{'letter'};
  if (! defined $letter) {
    # default first alphabetical in 'initial_string'
    $letter = substr($str,0,1);
  }
  unless (length($letter)) {
    # empty string no good as will match endlessly, change to a space which
    # will never match
    $letter = ' ';
  }
  $self->{'letter'} = $letter = lc($letter);

  &$without_conjunctions_func ($str);
  $str =~ s/[[:punct:][:space:]]+//g;  # strip non alphas
  ### initial: $str
  my $upto = 1;
  my $pos = 0;
  while (($pos = index($str,$letter,$pos)) >= 0) {
    push @ret, $pos++ + $upto;
  }
  $self->{'upto'} = $upto + length($str);
  ### initial: $self
  return $self;
}

sub _conjunctions_noop {
}

sub _fr_ordinal {
  my $str = Lingua::FR::Numbers::ordinate_to_fr($_[0]);
  # FIXME: "premiere" is per Sloane's sequence, should this be an option?
  if ($str eq 'premier') { $str = 'premiere'; }
  return $str;
}


sub next {
  my ($self) = @_;
  my $ret = $self->{'ret'};
  for (;;) {
    if (my $n = shift @$ret) {
      push @{$self->{'queue'}}, $n;
      return $n;
    }

    my $k = shift @{$self->{'queue'}}
      || return;  # end of sequence

    my $str = &{$self->{'ordinal_func'}}($k);
    ### orig str: $str
    &{$self->{'without_conjunctions_func'}}($str);
    &$unaccent ($str);
    $str = lc ($str);

    $str =~ s/[[:punct:][:space:]]+//g;  # strip non alphas
    ### munged str: $str

    my $upto = $self->{'upto'};
    my $letter = $self->{'letter'};
    my $pos = 0;
    while (($pos = index($str,$letter,$pos)) >= 0) {
      push @$ret, $pos++ + $upto;
    }
    $self->{'upto'} += length($str);
    ### now upto: $self->{'upto'}
    ### ret: $ret
    ### queue: $self->{'queue'}
  }
}

1;
__END__

=for stopwords Ryde Aronson Aronson's proven

=head1 NAME

Math::Aronson -- generate values of Aronson's sequence

=head1 SYNOPSIS

 use Math::Aronson;
 my $aronson = Math::Aronson->new;
 print $aronson->next,"\n";  # 1
 print $aronson->next,"\n";  # 4
 print $aronson->next,"\n";  # 11

=head1 DESCRIPTION

This is a bit of fun generating Aronson's sequence of numbers formed by
self-referential occurrences of letter T in numbers written out in words.

    T is the first, fourth, eleventh, sixteenth, ...
    ^    ^       ^      ^         ^      ^   ^
    1    4      11     16        24     29  33  <-- sequence

In the initial string "T is the", the letter T is the first and fourth
letters, so those words are appended to make "T is the first, fourth".  In
those words there are further Ts at 11 and 16, so those numbers are
appended, and so on.

Spaces and punctuation are ignored.  Accents like acutes are stripped for
matching.  The C<without_conjunctions> option can ignore "and" or "et" too.

=head2 Sloane's OEIS

Sloane's On-Line Encyclopedia of Integer Sequences has Aronson's original
sequence in English, plus a French form.

    http://www.research.att.com/~njas/sequences/A005224
    http://www.research.att.com/~njas/sequences/A080520

The English A005224 is without conjunctions, so is generated with

    $it = Math::Aronson->new (without_conjunctions => 1);

But the French A080520 is with them, so it's just

    $it = Math::Aronson->new (lang => 'fr');

=head2 Termination

It's possible for the English sequence to end, since there's no T in some
numbers, except there doesn't seem enough of those, or the sequence doesn't
fall on enough of them.  (Is that proven?)

But for example using letter "F" instead gives a finite sequence,

    $it = Math::Aronson->new (initial_string => 'F is the');

This is 1, 4, 9 per "F is the first, fourth, ninth" but ends there as
there's no more "F"s in "ninth".

=head1 FUNCTIONS

The sequence is an infinite recurrence (or may be) so is generated in
iterator style from an object created with various options.

=head2 Constructor

=over

=item C<< $it = Math::Aronson->new (key => value, ...) >>

Create and return a new Aronson sequence object.  The following optional
key/value parameters affect the sequence.

=over

=item C<< lang => $string >> (default "en")

The language to use for the sequence.  This can be anything recognised by
C<Lingua::Any::Numbers>.  "en" and "fr" have defaults for the options below.

=item C<< initial_string => $str >>

The initial string for the sequence.  The default is "T is the" for English
or "E est la" for French.  For other languages an C<initial_string> must be
given or the sequence is empty.

=item C<< letter => $str >>

The letter to look for in the words.  The default is the first letter of
C<initial_string>, so "T" for English or or "E" for French.

=item C<< without_conjunctions => $boolean >> (default false)

Strip conjunctions, meaning "and" in the wording, so for instance "one
hundred and four" becomes "one hundred four".  The default is keep whatever
conjunctions C<Lingua::Any::Numbers> (or the C<ordinal_func> below) gives
unchanged.

=item C<< conjunctions_word => $string >> (default "and" or "et")

The conjunction word to exclude if C<without_conjunctions> is true.  The
default is "and" for English or "et" for French.  For other languages
there's no default.

=item C<< ordinal_func => $coderef >> (default Lingua modules)

A function to call to turn a number into words,

    $str = &$ordinal_func ($n);

The default is to call C<to_ordinal($n,$lang)> from C<Lingua::Any::Numbers>,
or for English and French directly to the underlying C<Lingua::EN::Numbers>
or C<Lingua::FR::Numbers>.  The string can be wide chars.

C<Lingua::Any::Numbers> brings uniformity to the several number to words
modules, but if there's one not supported you can given an explicit
C<ordinal_func>.

    $it = Math::Aronson->new
             (ordinal_func => sub {
                my ($n) = @_;
                return something_made_from($n);
              });

There's nothing to select a gender from C<Lingua::Any::Numbers>, as of
version 0.30, so an C<ordinal_func> could be used for instance to get
feminine forms from C<Lingua::ES::Numbers>.

=back

=back

=head2 Operations

=over

=item C<< $n = $it->next >>

Return the next number in the sequence, being the next position of T (or
whatever letter) in the text.  The first position is 1.

If the end of the sequence has been reached the return is an empty list
(which means C<undef> in scalar context).  Since positions begin at 1 a loop
can be simply

    while (my $n = $it->next) {
      ...
    }

=back

=head1 SEE ALSO

L<Lingua::Any::Numbers>,
L<Lingua::EN::Numbers>,
L<Lingua::FR::Numbers>

=cut

# =item C<< hi => $integer >>, default C<undef>
# 
# The highest value desired from the sequence object.

