File Coverage

blib/lib/Iterator/Misc.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	19	24	79.1
condition	10	15	66.6
subroutine	15	15	100.0
pod	5	5	100.0
total	112	122	91.8

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