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

=head1 NAME

Iterator::Misc - Miscellaneous iterator functions.

=head1 VERSION

This documentation describes version 0.01 of Iterator::Misc, August 18, 2005.

=cut

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

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();
    });
}

# Function name: imesh / izip
# Synopsis:      $iter = imesh ($iter1, $iter2, ...)
# Description:   Merges other iterators together.
# Created:       07/30/2005 by EJR
# Parameters:    Any number of other iterators.
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Parameter_Error
#                Iterator::X::Am_Now_Exhausted
foreach my $sub (qw/imesh izip/)
{
    no strict 'refs';
    *$sub = sub
    {
        use strict 'refs';

        my @iterators = @_;
        my $it_index  = 0;

        foreach my $iter (@iterators)
        {
            Iterator::X::Parameter_Error->throw(
                "Argument to $sub is not an iterator")
                unless UNIVERSAL::isa($iter, 'Iterator');
        }

        return Iterator->new (sub
        {
            Iterator::is_done
                if is_exhausted($iterators[$it_index]);

            my $retval = $iterators[$it_index]->value();

            if (++$it_index >= @iterators)
            {
                $it_index = 0;
            }

            return $retval;
        });
    };
}

# Function name: iuniq
# Synopsis:      $iter = iuniq ($another_iterator);
# Description:   Removes duplicate entries from an iterator.
# Created:       07/30/2005 by EJR
# Parameters:    Another iterator.
# Returns:       Sequence iterator
# Exceptions:    Iterator::X::Parameter_Error
#                Iterator::X::Am_Now_Exhausted
sub iuniq
{
    Iterator::X::Parameter_Error->throw ("Too few parameters to iuniq")
        if @_ < 1;
    Iterator::X::Parameter_Error->throw ("Too many parameters to iuniq")
        if @_ > 1;

    my $iter = shift;
    Iterator::X::Parameter_Error->throw("Argument to iuniq is not an iterator")
        unless UNIVERSAL::isa($iter, 'Iterator');

    my %did_see;
    return Iterator->new (sub
    {
        my $value;
        while (1)
        {
            Iterator::is_done
                if $iter->is_exhausted;

            $value = $iter->value;
            last if !$did_see{$value}++;
        }
        return $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);

 # Mesh iterators together
 $iter = imesh ($iter, $iter, ...);
 $iter = izip  ($iter, $iter, ...);

 # Return each value of an iterator once
 $iter = iuniq ($another_iterator);

=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, ...

=item imesh

=item izip

 $iter = imesh ($iter1, $iter2, ...);

This iterator accepts any number of other iterators, and "meshes"
their values together.  First it returns the first value of the first
iterator, then the first value of the second iterator, and so on,
until it has returned the first value of all of its iterator
arguments.  Then it goes back and returns the second value of the
first iterator, and so on.  It stops when any of its iterator
arguments is exhausted.

I<Example:>

 $i1 = ilist ('a', 'b', 'c');
 $i2 = ilist (1, 2, 3);
 $i3 = ilist ('rock', 'paper', 'scissors');
 $iter = imesh ($i1, $i2, $i3);
 # $iter will return, in turn, 'a', 1, 'rock', 'b', 2, 'paper', 'c',...

C<izip> is a synonym for C<imesh>.

=item iuniq

 $iter = iuniq ($another_iterator);

Creates an iterator to return unique values from another iterator;
weeds out duplicates.

I<Example:>

 $iter = ilist (1, 2, 2, 3, 1, 4);
 $uniq = iuniq ($iter);            # returns 1, 2, 3, 4.

=back

=head1 EXPORTS

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

=head1 DIAGNOSTICS

Iterator::Util 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::Util 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.

If you have suggestions for improvement, please drop me a line.  If
you make improvements to this software, I ask that you please send me
a copy of your changes. Thanks.

=cut

=begin gpg

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

iD8DBQFDBMDnY96i4h5M0egRAhchAJ9z5sNEgANSRLyRrgeNcDxt5aRkVQCggIa3
Jvm4aQ41Di0TZH9f8WQJ44g=
=0ZCf
-----END PGP SIGNATURE-----

=end gpg
