List-Gen
view release on metacpan or search on metacpan
lib/List/Gen.pm view on Meta::CPAN
package List::Gen;
use warnings;
use strict;
use Carp;
use Symbol qw/delete_package/;
use Scalar::Util qw/reftype weaken openhandle blessed/;
our @list_util;
use List::Util
@list_util = qw/first max maxstr min minstr reduce shuffle sum/;
our @EXPORT = qw/mapn by every range gen cap filter cache apply
zip min max reduce glob iterate list/;
our %EXPORT_TAGS = (
base => \@EXPORT,
'List::Util' => \@list_util,
map {s/==//g; s/#.*//g;
/:(\w+)\s+(.+)/s ? ($1 => [split /\s+/ => $2]) : ()
} split /\n{2,}/ => q(
:utility mapn by every apply min max reduce mapab
mapkey d deref slide curse remove
:source range glob makegen list array vecgen repeat file
:modify gen cache expand contract collect slice flip overlay
test recursive sequence scan scan_stream == scanS
cartesian transpose stream strict
:zip zip zipgen tuples zipwith zipwithab unzip unzipn
zipmax zipgenmax zipwithmax
:iterate iterate
iterate_multi == iterateM
iterate_stream == iterateS
iterate_multi_stream == iterateMS
:gather gather
gather_stream == gatherS
gather_multi == gatherM
gather_multi_stream == gatherMS
:mutable mutable done done_if done_unless
:filter filter
filter_stream == filterS
filter_ # non-lookahead version
:while take_while == While
take_until == Until
while_ until_ # non-lookahead versions
drop_while drop_until
:numeric primes
:deprecated genzip
));
our @EXPORT_OK = keys %{{map {$_ => 1} map @$_, values %EXPORT_TAGS}};
$EXPORT_TAGS{all} = \@EXPORT_OK;
BEGIN {
require Exporter;
require overload;
require B;
*List::Generator:: = *List::Gen::;
}
sub import {
if (@_ == 2 and !$_[1] || $_[1] eq '*') {
splice @_, 1, 1, ':all', '\\'
}
push @_, '\\' if @_ == 1;
@_ = grep {/^&?\\$/ ? do {*\ = \∩ 0} : 1} @_;
@_ = map {/^<.*>$/ ? 'glob' : $_} @_;
goto &{Exporter->can('import')}
}
sub VERSION {
goto &{@_ > 1 && $_[1] == 0 ? *import : *UNIVERSAL::VERSION}
}
sub DEBUG () {}
DEBUG or $Carp::Internal{(__PACKAGE__)}++;
our $LIST = 0; # deprecated
our $LOOKAHEAD = 1;
our $DWIM_CODE_STRINGS = 0;
our $SAY_EVAL = 0;
lib/List/Gen.pm view on Meta::CPAN
=head1 NAME
List::Gen - provides functions for generating lists
=head1 VERSION
version 0.979
=head1 SYNOPSIS
this module provides higher order functions, list comprehensions, generators,
iterators, and other utility functions for working with lists. walk lists
with any step size you want, create lazy ranges and arrays with a map like
syntax that generate values on demand. there are several other hopefully useful
functions, and all functions from List::Util are available.
use List::Gen;
print "@$_\n" for every 5 => 1 .. 15;
# 1 2 3 4 5
# 6 7 8 9 10
# 11 12 13 14 15
print mapn {"$_[0]: $_[1]\n"} 2 => %myhash;
my $ints = <0..>;
my $squares = gen {$_**2} $ints;
say "@$squares[2 .. 6]"; # 4 9 16 25 36
$ints->zip('.', -$squares)->say(6); # 0-0 1-1 2-4 3-9 4-16 5-25
list(1, 2, 3)->gen('**2')->say; # 1 4 9
my $fib = ([0, 1] + iterate {fib($_, $_ + 1)->sum})->rec('fib');
my $fac = iterate {$_ < 2 or $_ * self($_ - 1)}->rec;
say "@$fib[0 .. 15]"; # 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610
say "@$fac[0 .. 10]"; # 1 1 2 6 24 120 720 5040 40320 362880 3628800
say <0, 1, * + * ...>->take(10)->str; # 0 1 1 2 3 5 8 13 21 34
say <[..*] 1, 1..>->str(8); # 1 1 2 6 24 120 720 5040
<**2 for 1..10 if even>->say; # 4 16 36 64 100
<1..>->map('**2')->grep(qr/1/)->say(5); # 1 16 81 100 121
=head1 EXPORT
use List::Gen; # is the same as
use List::Gen qw/mapn by every range gen cap \ filter cache apply zip
min max reduce glob iterate list/;
the following export tags are available:
:utility mapn by every apply min max reduce mapab
mapkey d deref slide curse remove
:source range glob makegen list array vecgen repeat file
:modify gen cache expand contract collect slice flip overlay
test recursive sequence scan scan_stream == scanS
cartesian transpose stream strict
:zip zip zipgen tuples zipwith zipwithab unzip unzipn
zipmax zipgenmax zipwithmax
:iterate iterate
iterate_multi == iterateM
iterate_stream == iterateS
iterate_multi_stream == iterateMS
:gather gather
gather_stream == gatherS
gather_multi == gatherM
gather_multi_stream == gatherMS
:mutable mutable done done_if done_unless
:filter filter
filter_stream == filterS
filter_ # non-lookahead version
:while take_while == While
take_until == Until
while_ until_ # non-lookahead versions
drop_while drop_until
:numeric primes
:deprecated genzip
:List::Util first max maxstr min minstr reduce shuffle sum
use List::Gen '*'; # everything
use List::Gen 0; # everything
use List::Gen ':all'; # everything
use List::Gen ':base'; # same as 'use List::Gen;'
use List::Gen (); # no exports
=cut
sub mapn (&$@);
#my @packages; END {print "package $_;\n" for sort @packages}
sub packager {
unshift @_, split /\s+/ => shift;
my $pkg = shift;
my @isa = deref(shift);
for ($pkg, @isa) {/:/ or s/^/List::Gen::/}
#push @packages, $pkg;
no strict 'refs';
*{$pkg.'::ISA'} = \@isa;
mapn {*{$pkg.'::'.$_} = pop} 2 => @_;
1
}
sub generator {
splice @_, 1, 0, 'Base', @_ > 1 ? 'TIEARRAY' : ();
goto &packager
}
sub mutable_gen {
lib/List/Gen.pm view on Meta::CPAN
=item * B<combinations>:
$gen->zip($gen2, ...) # takes any number of generators or array refs
$gen->cross($gen2) # cross product
$gen->cross2d($gen2) # returns a 2D generator containing the same
# elements as the flat ->cross generator
$gen->tuples($gen2) # tuples($gen, $gen2)
the C< zip > and the C< cross > methods all use the comma operator (C< ',' >)
by default to join their arguments. if the first argument to any of these
methods is code or a code like string, that will be used to join the arguments.
more detail in the overloaded operators section below
$gen->zip(',' => $gen2) # same as $gen->zip($gen2)
$gen->zip('.' => $gen2) # $gen[0].$gen2[0], $gen[1].$gen2[1], ...
=item * B<introspection>:
$gen->type # returns the package name of the generator
$gen->is_mutable # can the generator change size?
=item * B<utility>:
$gen->apply # causes a mutable generator to determine its true size
$gen->clone # copy a generator, resets the index
$gen->copy # copy a generator, preserves the index
$gen->purge # purge any caches in the source chain
=item * B<traversal>:
$gen->leaves # returns a coderef iterator that will perform a depth first
# traversal of the edge nodes in a tree of nested generators.
# a full run of the iterator will ->reset all of the internal
# generators
=item * B<while>:
$gen->while(...) # While {...} $gen
$gen->take_while(...) # same
$gen->drop_while(...) # $gen->drop( $gen->first_idx(sub {...}) )
$gen->span # collects $gen->next calls until one
# returns undef, then returns the collection.
# ->span starts from and moves the ->index
$gen->span(sub{...}) # span with an argument splits the list when the code
# returns false, it is equivalent to but more efficient
# than ($gen->take_while(...), $gen->drop_while(...))
$gen->break(...) # $gen->span(sub {not ...})
=item * B<tied vs methods>:
the methods duplicate and extend the tied functionality and are necessary when
working with indices outside of perl's array limit C< (0 .. 2**31 - 1) > or when
fetching a list return value (perl clamps the return to a scalar with the array
syntax). in all cases, they are also faster than the tied interface.
=item * B<functions as methods>:
most of the functions in this package are also methods of generators, including
by, every, mapn, gen, map (alias of gen), filter, grep (alias of filter), test,
cache, flip, reverse (alias of flip), expand, collect, overlay, mutable, while,
until, recursive, rec (alias of recursive).
my $gen = (range 0, 1_000_000)->gen(sub{$_**2})->filter(sub{$_ % 2});
#same as: filter {$_ % 2} gen {$_**2} 0, 1_000_000;
=item * B<dwim code>:
when a method takes a code ref, that code ref can be specified as a string
containing an operator and an optional curried argument (on either side)
my $gen = <0 .. 1_000_000>->map('**2')->grep('%2'); # same as above
you can prefix C< ! > or C< not > to negate the operator:
my $even = <1..>->grep('!%2'); # sub {not $_ % 2}
you can even use a typeglob to specify an operator when the method expects a
binary subroutine:
say <1 .. 10>->reduce(*+); # 55 # and saves a character over '+'
or a regex ref:
<1..30>->grep(qr/3/)->say; # 3 13 23 30
you can flip the arguments to a binary operator by prefixing it with C< R > or
by applying the C< ~ > operator to it:
say <a..d>->reduce('R.'); # 'dcba' # lowercase r works too
say <a..d>->reduce(~'.'); # 'dcba'
say <a..d>->reduce(~*.); # 'dcba'
=item * B<methods without return values>:
the methods that do not have a useful return value, such as C<< ->say >>,
return the same generator they were called with. this lets you easily insert
these methods at any point in a method chain for debugging.
=back
=head3 predicates
=over 4
several predicates are available to use with the filtering methods:
<1..>->grep('even' )->say(5); # 2 4 6 8 10
<1..>->grep('odd' )->say(5); # 1 3 5 7 9
<1..>->grep('prime')->say(5); # 2 3 5 7 11
<1.. if prime>->say(5); # 2 3 5 7 11
others are: defined, true, false
=back
=head3 lazy slices
=over 4
if you call the C< slice > method with a C< range > or other numeric generator
lib/List/Gen.pm view on Meta::CPAN
for my $sub (qw(
gen test cache expand contract collect flip While Until recursive
mutable by every filter filter_stream scan scan_stream
iterate iterate_multi iterate_stream iterate_multi_stream
gather gather_multi gather_stream gather_multi_stream
)) {
my $code = \&{"List::Gen::$sub"};
if ((prototype $code or '') =~ /^&/) {
*$sub = sub {
push @_, shift;
$sv2cv->(my $sub = shift);
unshift @_, $sub;
goto &$code;
}
} else {
*$sub = sub {push @_, shift; goto &$code}
}
if ($sub =~ /_/) {
(my $joined = $sub) =~ s/_//g;
(my $short = $sub) =~ s/_([a-z])[a-z]+/\U$1/g;
*$short = *$joined = *$sub;
}
}
{no warnings 'once';
*map = *gen;
*grep = *filter;
*x = *X = *cross;
*z = *Z = *zip;
*while = *take_while = *While;
*until = *take_until = *Until;
*rec = *with_self = *withself = *recursive;
*cached = *memoized = *memoize = *cache;
*filterS = *grepS = *grep_stream = *filter_stream;
}
for my $internal (qw(set_size when_done clear_done is_mutable set from
PUSH POP SHIFT UNSHIFT SPLICE tail_size load)) {
my $method = $internal eq 'is_mutable' ? 'mutable' : $internal;
my $search = $internal =~ /^(?:set_size|when_done|clear_done)$/;
*{lc $internal} = sub {
my $gen = shift;
my $self = tied @$gen;
if (my $code = $self->can($method) || $search && do {
my @src = $self->sources;
while (@src) {
last if $src[0]->can($method);
shift @src;
}
@src ? ($self = $src[0])->can($method) : ()
}) {
unshift @_, $self;
if ($internal =~ /^(PUSH|UNSHIFT|from|load)$/) {
&$code;
$gen
} else {&$code}
}
else {Carp::croak "no method '$method' on '".ref($self)."'"}
}
}
}
sub reverse {goto &List::Gen::flip}
sub overlay {goto &List::Gen::overlay}
sub zipmax {goto &List::Gen::zipgenmax}
sub zipwithmax {
my $code = splice @_, 1, 1;
$code->$sv2cv;
unshift @_, $code;
goto &List::Gen::zipwithmax
}
sub leaves {
my @stack = @_;
for (@stack) {
$_->reset if ref and List::Gen::isagen($_)
}
sub {
while (@stack and ref $stack[-1]
and List::Gen::isagen($stack[-1])) {
if (my @next = $stack[-1]->next) {
for (@next) {
$_->reset if ref and List::Gen::isagen($_)
}
push @stack, CORE::reverse @next;
} else {
(pop @stack)->reset;
}
}
@stack ? pop @stack : ()
}
}
{
my %threaded;
sub DESTROY {$_[0]->threads_stop if delete $threaded{$_[0]}}
sub threads_start {
$threaded{$_[0]} = 1;
my $self = tied @{$_[0]};
return if $$self{thread_queue};
my $threads = $_[1] || 4;
require threads;
require Thread::Queue;
$$self{$_} = Thread::Queue->new for qw(thread_queue thread_done);
my $fetch = $self->can('FETCH');
my $cached = $self->can('cached');
if ($cached or $$self{thread_cached}) {
if ($cached) {
$cached = $cached->();
unless (&threads::shared::is_shared($cached)) {
my $type = Scalar::Util::reftype $cached;
my @cache = $type eq 'HASH' ? %$cached : @$cached;
&threads::shared::share($cached);
($type eq 'HASH' ? %$cached : @$cached) = @cache;
}
} else {
my $real_fetch = $fetch;
my %cache;
&threads::shared::share(\%cache);
$fetch = sub {
exists $cache{$_[1]}
? $cache{$_[1]}
:($cache{$_[1]} = $real_fetch->(undef, $_[1]))
}
lib/List/Gen.pm view on Meta::CPAN
sub contract ($$) {
my ($scale, $gen) = @_;
croak '$_[0] >= 1' if $scale < 1;
croak 'not generator' unless isagen $gen;
$scale == 1
? $gen
: gen {&$gen($_ .. $_ + $scale - 1)} 0 => $gen->size - 1, $scale
}
BEGIN {*collect = \&contract}
=item scan C< {CODE} GENERATOR >
=item scan C< {CODE} LIST >
C< scan > is a C< reduce > that builds a list of all the intermediate values.
C< scan > returns a generator, and is the function behind the C<< <[..+]> >>
globstring reduction operator.
(scan {$a * $b} <1, 1..>)->say(8); # 1 1 2 6 24 120 720 5040 40320
say <[..*] 1, 1..>->str(8); # 1 1 2 6 24 120 720 5040 40320
say <1, 1..>->scan('*')->str(8); # 1 1 2 6 24 120 720 5040 40320
say <[..*]>->(1, 1 .. 7)->str; # 1 1 2 6 24 120 720 5040 40320
you can even use the C<< ->code >> method to tersely define a factorial
function:
*factorial = <[..*] 1, 1..>->code;
say factorial(5); # 120
a stream version C< scan_stream > is also available.
=cut
sub scan (&@) {
local *iterate = *iterate_stream if $STREAM;
my $binop = shift;
my $gen = (@_ == 1 && List::Gen::isagen($_[0]) or &makegen(\@_));
my $last;
if ($binop->$cv_wants_2_args) {
iterate {$last = defined $last ? $binop->($last, $_) : $_} $gen
} else {
my ($a, $b) = $binop->$cv_ab_ref;
iterate {$last = defined $last ? do {
local (*$a, *$b) = \($last, $_);
$binop->()
} : $_} $gen
}
}
sub scan_stream (&@) {
local *iterate = *iterate_stream;
&scan
}
BEGIN {*scanS = *scan_stream}
=item overlay C< GENERATOR PAIRS >
overlay allows you to replace the values of specific generator cells. to set
the values, either pass the overlay constructor a list of pairs in the form
C<< index => value, ... >>, or assign values to the returned generator using
normal array ref syntax
my $fib; $fib = overlay gen {$$fib[$_ - 1] + $$fib[$_ - 2]};
@$fib[0, 1] = (0, 1);
# or
my $fib; $fib = gen {$$fib[$_ - 1] + $$fib[$_ - 2]}
->overlay( 0 => 0, 1 => 1 );
print "@$fib[0 .. 15]"; # '0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610'
=cut
sub overlay ($%) {
isagen (my $source = shift)
or croak '$_[0] to overlay must be a generator';
tiegen Overlay => tied @$source, @_
}
generator Overlay => sub {
my ($class, $source, %overlay) = @_;
my ($fetch, $fsize) = $source->closures;
curse {
FETCH => sub {
exists $overlay{$_[1]}
? $overlay{$_[1]}
: $fetch->(undef, $_[1])
},
STORE => sub {$overlay{$_[1]} = $_[2]},
fsize => $fsize,
source => sub {$source}
} => $class
};
=item recursive C< [NAME] GENERATOR >
C< recursive > defines a subroutine named C< self(...) > or C< NAME(...) >
during generator execution. when called with no arguments it returns the
generator. when called with one or more numeric arguments, it fetches those
indices from the generator. when called with a generator, it returns a lazy
slice from the source generator. since the subroutine created by C< recursive >
is installed at runtime, you must call the subroutine with parenthesis.
my $fib = gen {self($_ - 1) + self($_ - 2)}
->overlay( 0 => 0, 1 => 1 )
->cache
->recursive;
print "@$fib[0 .. 15]"; # '0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610'
when used as a method, C<< $gen->recursive >> can be shortened to C<< $gen->rec >>.
my $fib = ([0, 1] + iterate {sum fib($_, $_ + 1)})->rec('fib');
print "@$fib[0 .. 15]"; # '0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610'
of course the fibonacci sequence is better written with the glob syntax as
C<< <0, 1, *+*...> >> which is compiled into something similar to the example
with C< iterate > above.
=cut
sub recursive {
isagen (my $source = pop)
or croak '$_[0] to recursive must be a generator';
tiegen Recursive => $source, tied @$source, scalar caller, @_;
}
generator Recursive => sub {
my ($class, $gen, $source) = @_;
my ($fetch, $fsize) = $source->closures;
my $caller = do {
no strict 'refs';
\*{$_[3].'::'.(@_ > 4 ? $_[4] : 'self')}
};
my $code = $gen->code;
my $self = sub {@_ ? &$code : $gen};
curse {
FETCH => sub {
no warnings 'redefine';
local *$caller = $self;
$fetch->(undef, $_[1])
},
fsize => $fsize,
source => sub {$source}
} => $class
};
=back
=head2 mutable generators
=over 4
=item filter C< {CODE} [ARGS_FOR_GEN] >
C< filter > is a lazy version of C< grep > which attaches a code block to a
generator. it returns a generator that will test elements with the code
block on demand. C< filter > processes its argument list the same way C< gen >
does.
C< filter > provides the functionality of the identical C<< ->filter(...) >> and
C<< ->grep(...) >> methods.
normal generators, such as those produced by C< range > or C< gen >, have a
( run in 1.737 second using v1.01-cache-2.11-cpan-5837b0d9d2c )