=for gpg
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

=head1 NAME

Iterator::Misc - Miscellaneous iterator functions.

=head1 VERSION

This documentation describes version 0.03 of Iterator::Misc, August 26, 2005.

=cut

use strict;
use warnings;
package Iterator::Misc;
our $VERSION = '0.03';

use base 'Exporter';
use vars qw/@EXPORT @EXPORT_OK %EXPORT_TAGS/;

@EXPORT      = qw(ipermute igeometric inth irand_nth ifibonacci);
@EXPORT_OK   = @EXPORT;

use Iterator;

# Function name: ipermute
# Synopsis:      $iter = ipermute (@items);
# Description:   Generates permutations of a list.
# Created:       07/29/2005 by EJR
# Parameters:    @items - the items to be permuted.
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Am_Now_Exhausted
# Notes:         Algorithm from MJD's book.
sub ipermute
{
    my @items = @_;
    my @digits = (0) x @items;     # "Odometer".  See Dominus, pp 128-135.

    return Iterator->new (sub
    {
        unless (@digits)
        {
            Iterator::is_done;
        }

        # Use the existing state to create a new permutation
        my @perm = ();
        my @c_items = @items;
        push @perm, splice(@c_items, $_, 1)  for @digits;

        # Find the rightmost column that isn't already maximum
        my $column = $#digits;
        until ($digits[$column] < $#digits-$column || $column < 0)
            { $column-- }

        if ($column < 0)
        {
            # Last set. Generate no more.
            @digits = ();
        }
        else
        {
            # Increment the rightmost column; set colums to the right to zeroes
            $digits[$column]++;
            $digits[$_] = 0  for ($column+1 .. $#digits);
        }

        return \@perm;
    });
}


# Function name: ifibonacci
# Synopsis:      $iter = ifibonacci ($start1, $start2);
# Description:   Generates a Fibonacci sequence.
# Created:       07/27/2005 by EJR
# Parameters:    $start1 - First starting value
#                $start2 - Second starting value
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Am_Now_Exhausted
# Notes:         If $start2 is omitted, $start1 is used for both.
#                If both are omitted, 1 is used for both.
sub ifibonacci
{
    my ($start1, $start2) = @_ == 0?  (1, 1)
                          : @_ == 1?  ($_[0], $_[0])
                          : @_ == 2?  @_
                          : Iterator::X::Parameter_Error->throw
                              ("Too many arguments to ifibonacci");

    return Iterator->new( sub
    {
        my $retval;
        ($retval, $start1, $start2) = ($start1, $start2, $start1+$start2);
        return $retval;
    });
}

# Function name: igeometric
# Synopsis:      $iter = igeometric ($start, $end, $factor);
# Description:   Generates a geometric sequence.
# Created:       07/28/2005 by EJR
# Parameters:    $start - Starting value
#                $end - Ending value
#                $factor - multiplier.
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Am_Now_Exhausted
# Notes:         If $end if omitted, series is unbounded.
#                $factor must be specified.
sub igeometric
{
    my ($start, $end, $factor) = @_;
    my $growing = abs($factor) >= 1;

    return Iterator->new (sub
    {
        Iterator::is_done
            if (defined $end  &&  ($growing && $start > $end  ||  !$growing && $start < $end));

        my $retval = $start;
        $start *= $factor;
        return $retval;
    });
}

# Function name: inth
# Synopsis:      $iter = inth ($n, $iter)
# Description:   Returns 1 out of every $n items.
# Created:       07/29/2005 by EJR
# Parameters:    $n - frequency
#                $iter - other iterator
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Parameter_Error
#                Iterator::X::Am_Now_Exhausted
sub inth
{
    my $n1 = -1 + shift;
    my $iter = shift;

    Iterator::X::Parameter_Error->throw('Invalid "$n" value for inth')
        if $n1 < 0;

    Iterator::X::Parameter_Error->throw
        (q{Second parameter for inth must be an Iterator})
            unless UNIVERSAL::isa($iter, 'Iterator');

    return Iterator->new (sub
    {
        my $i = $n1;
        while ($i-->0  &&  $iter->isnt_exhausted)
        {
            $iter->value();   # discard value
        }

        Iterator::is_done
            if $iter->is_exhausted;

        return $iter->value();
    });
}

# Function name: irand_nth
# Synopsis:      $iter = irand_nth ($n, $iter)
# Description:   Returns 1 out of every $n items, randomly.
# Created:       07/29/2005 by EJR
# Parameters:    $n - frequency
#                $iter - other iterator
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Parameter_Error
#                Iterator::X::Am_Now_Exhausted
sub irand_nth
{
    my $n    = shift;
    my $iter = shift;

    Iterator::X::Parameter_Error->throw('Invalid "$n" value for inth')
        if $n <= 0;

    Iterator::X::Parameter_Error->throw
        (q{Second parameter for irand_nth must be an Iterator})
            unless UNIVERSAL::isa($iter, 'Iterator');

    my $prob = 1 / $n;

    return Iterator->new (sub
    {
        while (rand > $prob  &&  $iter->isnt_exhausted)
        {
            $iter->value();   # discard value
        }

        Iterator::is_done
            if $iter->is_exhausted;

        return $iter->value();
    });
}


1;
__END__

=head1 SYNOPSIS

 use Iterator::Misc;

 # Permute the elements of a list:
 $iter = ipermute (@items);

 # Select only every nth value of an iterator
 $iter = inth ($n, $another_iterator);

 # Randomly select iterator values with 1/$n probability
 $iter = irand_nth ($n, $another_iterator);

 # Fibonacci sequence
 $ifib = ifibonacci();         # default sequence starts with 1,1
 $ifib = ifibonacci($a, $b);   # or specify alternate starting pair

 # Geometric sequence
 $iter = igeometric ($start, $end, $multiplier);

=head1 DESCRIPTION

This module contains miscellaneous iterator utility functions that I
think aren't as broadly useful as the ones in L<Iterator::Util>.
They are here to keep the size of Iterator::Util down.

For more information on iterators and how to use them, see the
L<Iterator> module documentation.

=head1 FUNCTIONS

=over 4

=item ipermute

 $iter = ipermute (@list);
 $array_ref = $iter->value();

Permutes the items in an arbitrary list.  Each time the iterator is
called, it returns the next combination of the items, in the form of a
reference to an array.

I<Example:>

 $iter = ipermute ('one', 'two', 'three');
 $ref  = $iter->value();          # -> ['one', 'two', 'three']
 $ref  = $iter->value();          # -> ['one', 'three', 'two']
 $ref  = $iter->value();          # -> ['two', 'one', 'three']
 # ...etc

=item inth

 $iter = inth ($n, $another_iterator);

Returns an iterator to return every I<nth> value from the input
iterator.  The first C<$n-1> items are skipped, then one is returned,
then the next C<$n-1> items are skipped, and so on.

This can be useful for sampling data.

=item irand_nth

 $iter = irand_nth ($n, $another_iterator);

Random I<nth>.  Returns an iterator to return items from the input
iterator, with a probability of C<1/$n> for each.  On average, in the
long run, 1 of every C<$n> items will be returned.

This can be useful for random sampling of data.

=item ifibonacci

 $iter = ifibonacci ();
 $iter = ifibonacci ($start);
 $iter = ifibonacci ($start1, $start2);

Generates a Fibonacci sequence.  If starting values are not specified,
uses (1, 1).  If only one is specified, it is used for both starting
values.

=item igeometric

 $iter = igeometric ($start, $end, $multiplier)

Generates a geometric sequence.  If C<$end> is undefined, the sequence
is unbounded.

I<Examples:>

 $iter = igeometric (1, 27, 3);         # 1, 3, 9, 27.
 $iter = igeometric (1, undef, 3);      # 1, 3, 9, 27, 81, ...
 $iter = igeometric (10, undef, 0.1);   # 10, 1, 0.1, 0.01, ...

=back

=head1 EXPORTS

All function names are exported to the caller's namespace by default.

=head1 DIAGNOSTICS

Iterator::Misc uses L<Exception::Class> objects for throwing
exceptions.  If you're not familiar with Exception::Class, don't
worry; these exception objects work just like C<$@> does with C<die>
and C<croak>, but they are easier to work with if you are trapping
errors.

For more information on how to handle these exception objects,
see the L<Iterator> documentation.

=over 4

=item * Parameter Errors

Class: C<Iterator::X::Parameter_Error>

You called an Iterator::Misc function with one or more bad parameters.
Since this is almost certainly a coding error, there is probably not
much use in handling this sort of exception.

As a string, this exception provides a human-readable message about
what the problem was.

=item * Exhausted Iterators

Class: C<Iterator::X::Exhausted>

You called L<value|Iterator/value> on an iterator that is exhausted;
that is, there are no more values in the sequence to return.

As a string, this exception is "Iterator is exhausted."

=item * User Code Exceptions

Class: C<Iterator::X::User_Code_Error>

This exception is thrown when the sequence generation code throws any
sort of error besides C<Am_Now_Exhausted>.  This could be because your
code explicitly threw an error (that is, C<die>d), or because it
otherwise encountered an exception (any runtime error).

This exception has one method, C<eval_error>, which returns the
original C<$@> that was trapped by the Iterator object.  This may be a
string or an object, depending on how C<die> was invoked.

As a string, this exception evaluates to the stringified C<$@>.

=item * Internal Errors

Class: C<Iterator::X::Internal_Error>

Something happened that I thought couldn't possibly happen.  I would
appreciate it if you could send me an email message detailing the
circumstances of the error.

=back

=head1 REQUIREMENTS

Requires the following additional modules:

L<Iterator>

=head1 SEE ALSO

I<Higher Order Perl>, Mark Jason Dominus, Morgan Kauffman 2005.

L<http://perl.plover.com/hop/>

=head1 THANKS

Much thanks to Will Coleda and Paul Lalli (and the RPI lily crowd in
general) for suggestions for the pre-release version.

=head1 AUTHOR / COPYRIGHT

Eric J. Roode, roode@cpan.org

Copyright (c) 2005 by Eric J. Roode.  All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

To avoid my spam filter, please include "Perl", "module", or this
module's name in the message's subject line, and/or GPG-sign your
message.

=cut

=begin gpg

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.1 (Cygwin)

iD8DBQFDD2FyY96i4h5M0egRAgDYAJ4xaco/BbTlPFjbNbtqxiqzRyyfaACfRY9Z
e4Z3srTvcJbhykfOsEuFJHA=
=V7w+
-----END PGP SIGNATURE-----

=end gpg