1 package List::MoreUtils;
10 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
11 @ISA = qw(Exporter DynaLoader);
14 all => [ qw(any all none notall true false firstidx first_index lastidx
15 last_index insert_after insert_after_string apply after after_incl before
16 before_incl indexes firstval first_value lastval last_value each_array
17 each_arrayref pairwise natatime mesh zip uniq minmax part bsearch) ],
20 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25 local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
26 bootstrap List::MoreUtils $VERSION;
28 } if not $ENV{LIST_MOREUTILS_PP};
30 eval <<'EOP' if not defined &any;
90 for my $i (0 .. $#_) {
99 for my $i (reverse 0 .. $#_) {
106 sub insert_after (&$\@) {
107 my ($code, $val, $list) = @_;
110 for my $i (0 .. $#$list) {
112 $c = $i, last if $code->();
114 @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
118 sub insert_after_string ($$\@) {
119 my ($string, $val, $list) = @_;
121 for my $i (0 .. $#$list) {
123 $c = $i, last if $string eq $list->[$i];
125 @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
131 &$action for my @values = @_;
132 wantarray ? @values : $values[-1];
140 grep $started ||= do { my $x=$lag; $lag=$test->(); $x}, @_;
147 grep $started ||= $test->(), @_;
154 grep $keepgoing &&= !$test->(), @_;
162 grep $keepgoing &&= do { my $x=$lag; $lag=!$test->(); $x}, @_;
168 grep {local *_=\$_[$_]; $test->()} 0..$#_;
175 for ($ix=$#_; $ix>=0; $ix--)
178 my $testval = $test->();
179 $_[$ix] = $_; # simulate $_ as alias
180 return $_ if $testval;
190 return $_ if $test->();
199 local (*A, *B) = @_; # syms for caller's input arrays
202 my ($caller_a, $caller_b) = do
206 \*{$pkg.'::a'}, \*{$pkg.'::b'};
209 my $limit = $#A > $#B? $#A : $#B; # loop iteration limit
211 local(*$caller_a, *$caller_b);
212 map # This map expression is also the return value.
214 # assign to $a, $b as refs to caller's array elements
215 (*$caller_a, *$caller_b) = \($A[$_], $B[$_]);
216 $op->(); # perform the transformation
220 sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
222 return each_arrayref(@_);
227 my @arr_list = @_; # The list of references to the arrays
228 my $index = 0; # Which one the caller will get next
229 my $max_num = 0; # Number of elements in longest array
231 # Get the length of the longest input array
234 unless (ref($_) eq 'ARRAY')
237 Carp::croak "each_arrayref: argument is not an array reference\n";
239 $max_num = @$_ if @$_ > $max_num;
242 # Return the iterator as a closure wrt the above variables.
248 if ($method eq 'index')
250 # Return current (last fetched) index
251 return undef if $index == 0 || $index > $max_num;
257 Carp::croak "each_array: unknown argument '$method' passed to iterator.";
261 return if $index >= $max_num; # No more elements to return
263 return map $_->[$i], @arr_list; # Return ith elements
274 return splice @list, 0, $n;
278 sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
280 $max < $#$_ && ($max = $#$_) for @_;
282 map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
288 map { $h{defined $_ ? $_ : $ref}++ == 0 ? $_ : () } @_;
293 my $min = my $max = $_[0];
295 for (my $i = 1; $i < @_; $i += 2) {
296 if ($_[$i-1] <= $_[$i]) {
297 $min = $_[$i-1] if $min > $_[$i-1];
298 $max = $_[$i] if $max < $_[$i];
300 $min = $_[$i] if $min > $_[$i];
301 $max = $_[$i-1] if $max < $_[$i-1];
307 if ($_[$i-1] <= $_[$i]) {
308 $min = $_[$i-1] if $min > $_[$i-1];
309 $max = $_[$i] if $max < $_[$i];
311 $min = $_[$i] if $min > $_[$i];
312 $max = $_[$i-1] if $max < $_[$i-1];
320 my ($code, @list) = @_;
322 push @{ $parts[$code->($_)] }, $_ for @list;
333 my $k = int(($i + $j) / 2);
341 return wantarray ? $_ : 1;
360 *first_index = \&firstidx;
361 *last_index = \&lastidx;
362 *first_value = \&firstval;
363 *last_value = \&lastval;
371 List::MoreUtils - Provide the stuff missing in List::Util
375 use List::MoreUtils qw(any all none notall true false firstidx first_index
376 lastidx last_index insert_after insert_after_string
377 apply after after_incl before before_incl indexes
378 firstval first_value lastval last_value each_array
379 each_arrayref pairwise natatime mesh zip uniq minmax);
383 C<List::MoreUtils> provides some trivial but commonly needed functionality on lists
384 which is not going to go into C<List::Util>.
386 All of the below functions are implementable in only a couple of lines of Perl
387 code. Using the functions from this module however should give slightly better
388 performance as everything is implemented in C. The pure-Perl implementation of
389 these functions only serves as a fallback in case the C portions of this module
390 couldn't be compiled on this machine.
396 Returns a true value if any item in LIST meets the criterion given through
397 BLOCK. Sets C<$_> for each item in LIST in turn:
399 print "At least one value undefined"
400 if any { !defined($_) } @list;
402 Returns false otherwise, or C<undef> if LIST is empty.
406 Returns a true value if all items in LIST meet the criterion given through
407 BLOCK. Sets C<$_> for each item in LIST in turn:
409 print "All items defined"
410 if all { defined($_) } @list;
412 Returns false otherwise, or C<undef> if LIST is empty.
414 =item none BLOCK LIST
416 Logically the negation of C<any>. Returns a true value if no item in LIST meets the
417 criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
419 print "No value defined"
420 if none { defined($_) } @list;
422 Returns false otherwise, or C<undef> if LIST is empty.
424 =item notall BLOCK LIST
426 Logically the negation of C<all>. Returns a true value if not all items in LIST meet
427 the criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
429 print "Not all values defined"
430 if notall { defined($_) } @list;
432 Returns false otherwise, or C<undef> if LIST is empty.
434 =item true BLOCK LIST
436 Counts the number of elements in LIST for which the criterion in BLOCK is true. Sets C<$_> for
437 each item in LIST in turn:
439 printf "%i item(s) are defined", true { defined($_) } @list;
441 =item false BLOCK LIST
443 Counts the number of elements in LIST for which the criterion in BLOCK is false. Sets C<$_> for
444 each item in LIST in turn:
446 printf "%i item(s) are not defined", false { defined($_) } @list;
448 =item firstidx BLOCK LIST
450 =item first_index BLOCK LIST
452 Returns the index of the first element in LIST for which the criterion in BLOCK is true. Sets C<$_>
453 for each item in LIST in turn:
455 my @list = (1, 4, 3, 2, 4, 6);
456 printf "item with index %i in list is 4", firstidx { $_ == 4 } @list;
458 item with index 1 in list is 4
460 Returns C<-1> if no such item could be found.
462 C<first_index> is an alias for C<firstidx>.
464 =item lastidx BLOCK LIST
466 =item last_index BLOCK LIST
468 Returns the index of the last element in LIST for which the criterion in BLOCK is true. Sets C<$_>
469 for each item in LIST in turn:
471 my @list = (1, 4, 3, 2, 4, 6);
472 printf "item with index %i in list is 4", lastidx { $_ == 4 } @list;
474 item with index 4 in list is 4
476 Returns C<-1> if no such item could be found.
478 C<last_index> is an alias for C<lastidx>.
480 =item insert_after BLOCK VALUE LIST
482 Inserts VALUE after the first item in LIST for which the criterion in BLOCK is true. Sets C<$_> for
483 each item in LIST in turn.
485 my @list = qw/This is a list/;
486 insert_after { $_ eq "a" } "longer" => @list;
489 This is a longer list
491 =item insert_after_string STRING VALUE LIST
493 Inserts VALUE after the first item in LIST which is equal to STRING.
495 my @list = qw/This is a list/;
496 insert_after_string "a", "longer" => @list;
499 This is a longer list
501 =item apply BLOCK LIST
503 Applies BLOCK to each item in LIST and returns a list of the values after BLOCK
504 has been applied. In scalar context, the last element is returned. This
505 function is similar to C<map> but will not modify the elements of the input
509 my @mult = apply { $_ *= 2 } @list;
510 print "\@list = @list\n";
511 print "\@mult = @mult\n";
516 Think of it as syntactic sugar for
518 for (my @mult = @list) { $_ *= 2 }
520 =item after BLOCK LIST
522 Returns a list of the values of LIST after (and not including) the point
523 where BLOCK returns a true value. Sets C<$_> for each element in LIST in turn.
525 @x = after { $_ % 5 == 0 } (1..9); # returns 6, 7, 8, 9
527 =item after_incl BLOCK LIST
529 Same as C<after> but also inclues the element for which BLOCK is true.
531 =item before BLOCK LIST
533 Returns a list of values of LIST upto (and not including) the point where BLOCK
534 returns a true value. Sets C<$_> for each element in LIST in turn.
536 =item before_incl BLOCK LIST
538 Same as C<before> but also includes the element for which BLOCK is true.
540 =item indexes BLOCK LIST
542 Evaluates BLOCK for each element in LIST (assigned to C<$_>) and returns a list
543 of the indices of those elements for which BLOCK returned a true value. This is
544 just like C<grep> only that it returns indices instead of values:
546 @x = indexes { $_ % 2 == 0 } (1..10); # returns 1, 3, 5, 7, 9
548 =item firstval BLOCK LIST
550 =item first_value BLOCK LIST
552 Returns the first element in LIST for which BLOCK evaluates to true. Each
553 element of LIST is set to C<$_> in turn. Returns C<undef> if no such element
556 C<first_val> is an alias for C<firstval>.
558 =item lastval BLOCK LIST
560 =item last_value BLOCK LIST
562 Returns the last value in LIST for which BLOCK evaluates to true. Each element
563 of LIST is set to C<$_> in turn. Returns C<undef> if no such element has been
566 C<last_val> is an alias for C<lastval>.
568 =item pairwise BLOCK ARRAY1 ARRAY2
570 Evaluates BLOCK for each pair of elements in ARRAY1 and ARRAY2 and returns a
571 new list consisting of BLOCK's return values. The two elements are set to C<$a>
572 and C<$b>. Note that those two are aliases to the original value so changing
573 them will modify the input arrays.
577 @x = pairwise { $a + $b } @a, @b; # returns 12, 14, 16, 18, 20
582 @x = pairwise { ($a, $b) } @a, @b; # returns a, 1, b, 2, c, 3
584 =item each_array ARRAY1 ARRAY2 ...
586 Creates an array iterator to return the elements of the list of arrays ARRAY1,
587 ARRAY2 throughout ARRAYn in turn. That is, the first time it is called, it
588 returns the first element of each array. The next time, it returns the second
589 elements. And so on, until all elements are exhausted.
591 This is useful for looping over more than one array at once:
593 my $ea = each_array(@a, @b, @c);
594 while ( my ($a, $b, $c) = $ea->() ) { .... }
596 The iterator returns the empty list when it reached the end of all arrays.
598 If the iterator is passed an argument of 'C<index>', then it retuns
599 the index of the last fetched set of values, as a scalar.
601 =item each_arrayref LIST
603 Like each_array, but the arguments are references to arrays, not the
606 =item natatime BLOCK LIST
608 Creates an array iterator, for looping over an array in chunks of
609 C<$n> items at a time. (n at a time, get it?). An example is
610 probably a better explanation than I could give in words.
614 my @x = ('a' .. 'g');
615 my $it = natatime 3, @x;
616 while (my @vals = $it->())
627 =item mesh ARRAY1 ARRAY2 [ ARRAY3 ... ]
629 =item zip ARRAY1 ARRAY2 [ ARRAY3 ... ]
631 Returns a list consisting of the first elements of each array, then
632 the second, then the third, etc, until all arrays are exhausted.
638 @z = mesh @x, @y; # returns a, 1, b, 2, c, 3, d, 4
642 @c = qw/zip zap zot/;
643 @d = mesh @a, @b, @c; # x, 1, zip, undef, 2, zap, undef, undef, zot
645 C<zip> is an alias for C<mesh>.
649 Returns a new list by stripping duplicate values in LIST. The order of
650 elements in the returned list is the same as in LIST. In scalar context,
651 returns the number of unique elements in LIST.
653 my @x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 1 2 3 5 4
654 my $x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 5
658 Calculates the minimum and maximum of LIST and returns a two element list with
659 the first element being the minimum and the second the maximum. Returns the empty
660 list if LIST was empty.
662 The minmax algorithm differs from a naive iteration over the list where each element
663 is compared to two values being the so far calculated min and max value in that it
664 only requires 3n/2 - 2 comparisons. Thus it is the most efficient possible algorithm.
666 However, the Perl implementation of it has some overhead simply due to the fact
667 that there are more lines of Perl code involved. Therefore, LIST needs to be
668 fairly big in order for minmax to win over a naive implementation. This
669 limitation does not apply to the XS version.
671 =item part BLOCK LIST
673 Partitions LIST based on the return value of BLOCK which denotes into which partition
674 the current value is put.
676 Returns a list of the partitions thusly created. Each partition created is a
677 reference to an array.
680 my @part = part { $i++ % 2 } 1 .. 8; # returns [1, 3, 5, 7], [2, 4, 6, 8]
682 You can have a sparse list of partitions as well where non-set partitions will
685 my @part = part { 2 } 1 .. 10; # returns undef, undef, [ 1 .. 10 ]
687 Be careful with negative values, though:
689 my @part = part { -1 } 1 .. 10;
691 Modification of non-creatable array value attempted, subscript -1 ...
693 Negative values are only ok when they refer to a partition previously created:
695 my @idx = (0, 1, -1);
697 my @part = part { $idx[$++ % 3] } 1 .. 8; # [1, 4, 7], [2, 3, 5, 6, 8]
699 =item bsearch BLOCK LIST
701 Performs a binary search on LIST which must be a sorted list of values. BLOCK
702 must return a negative value if the current element (stored in C<$_>) is smaller,
703 a positive value if it is bigger and zero if it matches.
705 Returns a boolean value in scalar context. In list context, it returns the element
706 if it was found, otherwise the empty list.
712 Nothing by default. To import all of this module's symbols, do the conventional
714 use List::MoreUtils qw/:all/;
716 It may make more sense though to only import the stuff your program actually needs:
718 use List::MoreUtils qw/any firstidx/;
722 When C<LIST_MOREUTILS_PP> is set, the module will always use the pure-Perl
723 implementation and not the XS one. This environment variable is really just
724 there for the test-suite to force testing the Perl implementation, and possibly
725 for reporting of bugs. I don't see any reason to use it in a production
730 This is version 0.25_01.
734 There is a problem with a bug in 5.6.x perls. It is a syntax error to write
737 my @x = apply { s/foo/bar/ } qw/foo bar baz/;
739 It has to be written as either
741 my @x = apply { s/foo/bar/ } 'foo', 'bar', 'baz';
745 my @x = apply { s/foo/bar/ } my @dummy = qw/foo bar baz/;
747 Perl5.5.x and perl5.8.x don't suffer from this limitation.
749 If you have a functionality that you could imagine being in this module, please
750 drop me a line. This module's policy will be less strict than C<List::Util>'s when
751 it comes to additions as it isn't a core module.
753 When you report bugs, it would be nice if you could additionally give me the
754 output of your program with the environment variable C<LIST_MOREUTILS_PP> set
755 to a true value. That way I know where to look for the problem (in XS,
756 pure-Perl or possibly both).
760 Credits go to a number of people: Steve Purkis for giving me namespace advice
761 and James Keenan and Terrence Branno for their effort of keeping the CPAN
762 tidier by making List::Utils obsolete.
764 Brian McCauley suggested the inclusion of apply() and provided the pure-Perl
765 implementation for it.
767 Eric J. Roode asked me to add all functions from his module C<List::MoreUtil>
768 into this one. With minor modifications, the pure-Perl implementations of those
771 The bunch of people who almost immediately pointed out the many problems with
772 the glitchy 0.07 release (Slaven Rezic, Ron Savage, CPAN testers).
774 A particularly nasty memory leak was spotted by Thomas A. Lowery.
776 Lars Thegler made me aware of problems with older Perl versions.
778 Anno Siegel de-orphaned each_arrayref().
780 David Filmer made me aware of a problem in each_arrayref that could ultimately
783 Ricardo Signes suggested the inclusion of part() and provided the
786 Robin Huston kindly fixed a bug in perl's MULTICALL API to make the
787 XS-implementation of part() work.
791 A pile of requests from other people is still pending further processing in my
792 mailbox. This includes:
798 Use code-reference to extract a key based on which the uniqueness is
799 determined. Suggested by Aaron Crane.
805 =item * random_item_delete_index
807 =item * list_diff_hash
809 =item * list_diff_inboth
811 =item * list_diff_infirst
813 =item * list_diff_insecond
815 These were all suggested by Dan Muey.
819 Always return a flat list when either a simple scalar value was passed or an array-reference.
820 Suggested by Mark Summersault.
830 Tassilo von Parseval, E<lt>vparseval@gmail.comE<gt>
832 =head1 COPYRIGHT AND LICENSE
834 Copyright (C) 2004-2009 by Tassilo von Parseval
836 This library is free software; you can redistribute it and/or modify
837 it under the same terms as Perl itself, either Perl version 5.8.4 or,
838 at your option, any later version of Perl 5 you may have available.