Profile of /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/List/MoreUtils.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:47 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/List/MoreUtils.pm
Statements Executed | 26
Statement Execution Time | 347µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
118 | 2 | 2 | 267µs | 267µs | List::MoreUtils::::firstidxList::MoreUtils::firstidx (xsub)
49 | 3 | 3 | 220µs | 267µs | List::MoreUtils::::allList::MoreUtils::all (xsub)
1 | 1 | 2 | 64µs | 64µs | List::MoreUtils::::bootstrapList::MoreUtils::bootstrap (xsub)
1 | 1 | 1 | 35µs | 35µs | List::MoreUtils::::BEGIN@3List::MoreUtils::BEGIN@3
5 | 1 | 2 | 32µs | 32µs | List::MoreUtils::::uniqList::MoreUtils::uniq (xsub)
1 | 1 | 2 | 30µs | 31µs | List::MoreUtils::::anyList::MoreUtils::any (xsub)
1 | 1 | 1 | 7µs | 11µs | List::MoreUtils::::BEGIN@4List::MoreUtils::BEGIN@4
1 | 1 | 1 | 7µs | 68µs | List::MoreUtils::::BEGIN@8List::MoreUtils::BEGIN@8

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package List::MoreUtils;
2 |  |  |  |  |
3 | 3 | 45µs | 1 | 35µs | # spent 35µs within List::MoreUtils::BEGIN@3 which was called # once (35µs+0s) by Moose::Exporter::BEGIN@12 at line 3 use 5.00503; # spent 35µs making 1 call to List::MoreUtils::BEGIN@3
4 | 3 | 28µs | 2 | 15µs | # spent 11µs (7+4) within List::MoreUtils::BEGIN@4 which was called # once (7µs+4µs) by Moose::Exporter::BEGIN@12 at line 4 use strict; # spent 11µs making 1 call to List::MoreUtils::BEGIN@4 # spent 4µs making 1 call to strict::import
5 |  |  |  |  |
6 | 1 | 400ns |  |  | require Exporter;
7 | 1 | 100ns |  |  | require DynaLoader;
8 | 3 | 206µs | 2 | 130µs | # spent 68µs (7+62) within List::MoreUtils::BEGIN@8 which was called # once (7µs+62µs) by Moose::Exporter::BEGIN@12 at line 8 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); # spent 68µs making 1 call to List::MoreUtils::BEGIN@8 # spent 62µs making 1 call to vars::import
9 | 1 | 12µs |  |  | @ISA = qw(Exporter DynaLoader);
10 |  |  |  |  |
11 | 1 | 5µs |  |  | %EXPORT_TAGS = (
12 |  |  |  |  | all => [ qw(any all none notall true false firstidx first_index lastidx
13 |  |  |  |  | last_index insert_after insert_after_string apply after after_incl before
14 |  |  |  |  | before_incl indexes firstval first_value lastval last_value each_array
15 |  |  |  |  | each_arrayref pairwise natatime mesh zip uniq minmax part) ],
16 |  |  |  |  | );
17 |  |  |  |  |
18 | 1 | 11µs |  |  | @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
19 |  |  |  |  |
20 | 1 | 300ns |  |  | $VERSION = '0.22';
21 |  |  |  |  |
22 | 4 | 9µs |  |  | eval {
23 |  |  |  |  | local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
24 |  |  |  |  | bootstrap List::MoreUtils $VERSION; # spent 382µs making 1 call to DynaLoader::bootstrap
25 |  |  |  |  | 1;
26 |  |  |  |  | } if not $ENV{LIST_MOREUTILS_PP};
27 |  |  |  |  |
28 | 1 | 500ns |  |  | eval <<'EOP' if not defined &any;
29 |  |  |  |  |
30 |  |  |  |  | sub any (&@) {
31 |  |  |  |  | my $f = shift;
32 |  |  |  |  | return if ! @_;
33 |  |  |  |  | for (@_) {
34 |  |  |  |  | return 1 if $f->();
35 |  |  |  |  | }
36 |  |  |  |  | return 0;
37 |  |  |  |  | }
38 |  |  |  |  |
39 |  |  |  |  | sub all (&@) {
40 |  |  |  |  | my $f = shift;
41 |  |  |  |  | return if ! @_;
42 |  |  |  |  | for (@_) {
43 |  |  |  |  | return 0 if ! $f->();
44 |  |  |  |  | }
45 |  |  |  |  | return 1;
46 |  |  |  |  | }
47 |  |  |  |  |
48 |  |  |  |  | sub none (&@) {
49 |  |  |  |  | my $f = shift;
50 |  |  |  |  | return if ! @_;
51 |  |  |  |  | for (@_) {
52 |  |  |  |  | return 0 if $f->();
53 |  |  |  |  | }
54 |  |  |  |  | return 1;
55 |  |  |  |  | }
56 |  |  |  |  |
57 |  |  |  |  | sub notall (&@) {
58 |  |  |  |  | my $f = shift;
59 |  |  |  |  | return if ! @_;
60 |  |  |  |  | for (@_) {
61 |  |  |  |  | return 1 if ! $f->();
62 |  |  |  |  | }
63 |  |  |  |  | return 0;
64 |  |  |  |  | }
65 |  |  |  |  |
66 |  |  |  |  | sub true (&@) {
67 |  |  |  |  | my $f = shift;
68 |  |  |  |  | my $count = 0;
69 |  |  |  |  | for (@_) {
70 |  |  |  |  | $count++ if $f->();
71 |  |  |  |  | }
72 |  |  |  |  | return $count;
73 |  |  |  |  | }
74 |  |  |  |  |
75 |  |  |  |  | sub false (&@) {
76 |  |  |  |  | my $f = shift;
77 |  |  |  |  | my $count = 0;
78 |  |  |  |  | for (@_) {
79 |  |  |  |  | $count++ if ! $f->();
80 |  |  |  |  | }
81 |  |  |  |  | return $count;
82 |  |  |  |  | }
83 |  |  |  |  |
84 |  |  |  |  | sub firstidx (&@) {
85 |  |  |  |  | my $f = shift;
86 |  |  |  |  | for my $i (0 .. $#_) {
87 |  |  |  |  | local *_ = \$_[$i];
88 |  |  |  |  | return $i if $f->();
89 |  |  |  |  | }
90 |  |  |  |  | return -1;
91 |  |  |  |  | }
92 |  |  |  |  |
93 |  |  |  |  | sub lastidx (&@) {
94 |  |  |  |  | my $f = shift;
95 |  |  |  |  | for my $i (reverse 0 .. $#_) {
96 |  |  |  |  | local *_ = \$_[$i];
97 |  |  |  |  | return $i if $f->();
98 |  |  |  |  | }
99 |  |  |  |  | return -1;
100 |  |  |  |  | }
101 |  |  |  |  |
102 |  |  |  |  | sub insert_after (&$\@) {
103 |  |  |  |  | my ($code, $val, $list) = @_;
104 |  |  |  |  | my $c = -1;
105 |  |  |  |  | local *_;
106 |  |  |  |  | for my $i (0 .. $#$list) {
107 |  |  |  |  | $_ = $list->[$i];
108 |  |  |  |  | $c = $i, last if $code->();
109 |  |  |  |  | }
110 |  |  |  |  | @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
111 |  |  |  |  | return 0;
112 |  |  |  |  | }
113 |  |  |  |  |
114 |  |  |  |  | sub insert_after_string ($$\@) {
115 |  |  |  |  | my ($string, $val, $list) = @_;
116 |  |  |  |  | my $c = -1;
117 |  |  |  |  | for my $i (0 .. $#$list) {
118 |  |  |  |  | local $^W = 0;
119 |  |  |  |  | $c = $i, last if $string eq $list->[$i];
120 |  |  |  |  | }
121 |  |  |  |  | @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
122 |  |  |  |  | return 0;
123 |  |  |  |  | }
124 |  |  |  |  |
125 |  |  |  |  | sub apply (&@) {
126 |  |  |  |  | my $action = shift;
127 |  |  |  |  | &$action for my @values = @_;
128 |  |  |  |  | wantarray ? @values : $values[-1];
129 |  |  |  |  | }
130 |  |  |  |  |
131 |  |  |  |  | sub after (&@)
132 |  |  |  |  | {
133 |  |  |  |  | my $test = shift;
134 |  |  |  |  | my $started;
135 |  |  |  |  | my $lag;
136 |  |  |  |  | grep $started ||= do { my $x=$lag; $lag=$test->(); $x}, @_;
137 |  |  |  |  | }
138 |  |  |  |  |
139 |  |  |  |  | sub after_incl (&@)
140 |  |  |  |  | {
141 |  |  |  |  | my $test = shift;
142 |  |  |  |  | my $started;
143 |  |  |  |  | grep $started ||= $test->(), @_;
144 |  |  |  |  | }
145 |  |  |  |  |
146 |  |  |  |  | sub before (&@)
147 |  |  |  |  | {
148 |  |  |  |  | my $test = shift;
149 |  |  |  |  | my $keepgoing=1;
150 |  |  |  |  | grep $keepgoing &&= !$test->(), @_;
151 |  |  |  |  | }
152 |  |  |  |  |
153 |  |  |  |  | sub before_incl (&@)
154 |  |  |  |  | {
155 |  |  |  |  | my $test = shift;
156 |  |  |  |  | my $keepgoing=1;
157 |  |  |  |  | my $lag=1;
158 |  |  |  |  | grep $keepgoing &&= do { my $x=$lag; $lag=!$test->(); $x}, @_;
159 |  |  |  |  | }
160 |  |  |  |  |
161 |  |  |  |  | sub indexes (&@)
162 |  |  |  |  | {
163 |  |  |  |  | my $test = shift;
164 |  |  |  |  | grep {local *_=\$_[$_]; $test->()} 0..$#_;
165 |  |  |  |  | }
166 |  |  |  |  |
167 |  |  |  |  | sub lastval (&@)
168 |  |  |  |  | {
169 |  |  |  |  | my $test = shift;
170 |  |  |  |  | my $ix;
171 |  |  |  |  | for ($ix=$#_; $ix>=0; $ix--)
172 |  |  |  |  | {
173 |  |  |  |  | local *_ = \$_[$ix];
174 |  |  |  |  | my $testval = $test->();
175 |  |  |  |  | $_[$ix] = $_; # simulate $_ as alias
176 |  |  |  |  | return $_ if $testval;
177 |  |  |  |  | }
178 |  |  |  |  | return undef;
179 |  |  |  |  | }
180 |  |  |  |  |
181 |  |  |  |  | sub firstval (&@)
182 |  |  |  |  | {
183 |  |  |  |  | my $test = shift;
184 |  |  |  |  | foreach (@_)
185 |  |  |  |  | {
186 |  |  |  |  | return $_ if $test->();
187 |  |  |  |  | }
188 |  |  |  |  | return undef;
189 |  |  |  |  | }
190 |  |  |  |  |
191 |  |  |  |  | sub pairwise(&\@\@)
192 |  |  |  |  | {
193 |  |  |  |  | my $op = shift;
194 |  |  |  |  | use vars qw/@A @B/;
195 |  |  |  |  | local (*A, *B) = @_; # syms for caller's input arrays
196 |  |  |  |  |
197 |  |  |  |  | # Localise $a, $b
198 |  |  |  |  | my ($caller_a, $caller_b) = do
199 |  |  |  |  | {
200 |  |  |  |  | my $pkg = caller();
201 |  |  |  |  | no strict 'refs';
202 |  |  |  |  | \*{$pkg.'::a'}, \*{$pkg.'::b'};
203 |  |  |  |  | };
204 |  |  |  |  |
205 |  |  |  |  | my $limit = $#A > $#B? $#A : $#B; # loop iteration limit
206 |  |  |  |  |
207 |  |  |  |  | local(*$caller_a, *$caller_b);
208 |  |  |  |  | map # This map expression is also the return value.
209 |  |  |  |  | {
210 |  |  |  |  | # assign to $a, $b as refs to caller's array elements
211 |  |  |  |  | (*$caller_a, *$caller_b) = \($A[$_], $B[$_]);
212 |  |  |  |  | $op->(); # perform the transformation
213 |  |  |  |  | } 0 .. $limit;
214 |  |  |  |  | }
215 |  |  |  |  |
216 |  |  |  |  | sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
217 |  |  |  |  | {
218 |  |  |  |  | return each_arrayref(@_);
219 |  |  |  |  | }
220 |  |  |  |  |
221 |  |  |  |  | sub each_arrayref
222 |  |  |  |  | {
223 |  |  |  |  | my @arr_list = @_; # The list of references to the arrays
224 |  |  |  |  | my $index = 0; # Which one the caller will get next
225 |  |  |  |  | my $max_num = 0; # Number of elements in longest array
226 |  |  |  |  |
227 |  |  |  |  | # Get the length of the longest input array
228 |  |  |  |  | foreach (@arr_list)
229 |  |  |  |  | {
230 |  |  |  |  | unless (ref($_) eq 'ARRAY')
231 |  |  |  |  | {
232 |  |  |  |  | require Carp;
233 |  |  |  |  | Carp::croak "each_arrayref: argument is not an array reference\n";
234 |  |  |  |  | }
235 |  |  |  |  | $max_num = @$_ if @$_ > $max_num;
236 |  |  |  |  | }
237 |  |  |  |  |
238 |  |  |  |  | # Return the iterator as a closure wrt the above variables.
239 |  |  |  |  | return sub
240 |  |  |  |  | {
241 |  |  |  |  | if (@_)
242 |  |  |  |  | {
243 |  |  |  |  | my $method = shift;
244 |  |  |  |  | if ($method eq 'index')
245 |  |  |  |  | {
246 |  |  |  |  | # Return current (last fetched) index
247 |  |  |  |  | return undef if $index == 0 || $index > $max_num;
248 |  |  |  |  | return $index-1;
249 |  |  |  |  | }
250 |  |  |  |  | else
251 |  |  |  |  | {
252 |  |  |  |  | require Carp;
253 |  |  |  |  | Carp::croak "each_array: unknown argument '$method' passed to iterator.";
254 |  |  |  |  | }
255 |  |  |  |  | }
256 |  |  |  |  |
257 |  |  |  |  | return if $index >= $max_num; # No more elements to return
258 |  |  |  |  | my $i = $index++;
259 |  |  |  |  | return map $_->[$i], @arr_list; # Return ith elements
260 |  |  |  |  | }
261 |  |  |  |  | }
262 |  |  |  |  |
263 |  |  |  |  | sub natatime ($@)
264 |  |  |  |  | {
265 |  |  |  |  | my $n = shift;
266 |  |  |  |  | my @list = @_;
267 |  |  |  |  |
268 |  |  |  |  | return sub
269 |  |  |  |  | {
270 |  |  |  |  | return splice @list, 0, $n;
271 |  |  |  |  | }
272 |  |  |  |  | }
273 |  |  |  |  |
274 |  |  |  |  | sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
275 |  |  |  |  | my $max = -1;
276 |  |  |  |  | $max < $#$_ && ($max = $#$_) for @_;
277 |  |  |  |  |
278 |  |  |  |  | map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
279 |  |  |  |  | }
280 |  |  |  |  |
281 |  |  |  |  | sub uniq (@) {
282 |  |  |  |  | my %h;
283 |  |  |  |  | map { $h{$_}++ == 0 ? $_ : () } @_;
284 |  |  |  |  | }
285 |  |  |  |  |
286 |  |  |  |  | sub minmax (@) {
287 |  |  |  |  | return if ! @_;
288 |  |  |  |  | my $min = my $max = $_[0];
289 |  |  |  |  |
290 |  |  |  |  | for (my $i = 1; $i < @_; $i += 2) {
291 |  |  |  |  | if ($_[$i-1] <= $_[$i]) {
292 |  |  |  |  | $min = $_[$i-1] if $min > $_[$i-1];
293 |  |  |  |  | $max = $_[$i] if $max < $_[$i];
294 |  |  |  |  | } else {
295 |  |  |  |  | $min = $_[$i] if $min > $_[$i];
296 |  |  |  |  | $max = $_[$i-1] if $max < $_[$i-1];
297 |  |  |  |  | }
298 |  |  |  |  | }
299 |  |  |  |  |
300 |  |  |  |  | if (@_ & 1) {
301 |  |  |  |  | my $i = $#_;
302 |  |  |  |  | if ($_[$i-1] <= $_[$i]) {
303 |  |  |  |  | $min = $_[$i-1] if $min > $_[$i-1];
304 |  |  |  |  | $max = $_[$i] if $max < $_[$i];
305 |  |  |  |  | } else {
306 |  |  |  |  | $min = $_[$i] if $min > $_[$i];
307 |  |  |  |  | $max = $_[$i-1] if $max < $_[$i-1];
308 |  |  |  |  | }
309 |  |  |  |  | }
310 |  |  |  |  |
311 |  |  |  |  | return ($min, $max);
312 |  |  |  |  | }
313 |  |  |  |  |
314 |  |  |  |  | sub part(&@) {
315 |  |  |  |  | my ($code, @list) = @_;
316 |  |  |  |  | my @parts;
317 |  |  |  |  | push @{ $parts[$code->($_)] }, $_ for @list;
318 |  |  |  |  | return @parts;
319 |  |  |  |  | }
320 |  |  |  |  |
321 |  |  |  |  | sub _XScompiled {
322 |  |  |  |  | return 0;
323 |  |  |  |  | }
324 |  |  |  |  |
325 |  |  |  |  | EOP
326 |  |  |  |  |
327 | 1 | 900ns |  |  | *first_index = \&firstidx;
328 | 1 | 300ns |  |  | *last_index = \&lastidx;
329 | 1 | 300ns |  |  | *first_value = \&firstval;
330 | 1 | 200ns |  |  | *last_value = \&lastval;
331 | 1 | 200ns |  |  | *zip = \&mesh;
332 |  |  |  |  |
333 | 1 | 28µs |  |  | 1;
334 |  |  |  |  | __END__
335 |  |  |  |  |
336 |  |  |  |  | =head1 NAME
337 |  |  |  |  |
338 |  |  |  |  | List::MoreUtils - Provide the stuff missing in List::Util
339 |  |  |  |  |
340 |  |  |  |  | =head1 SYNOPSIS
341 |  |  |  |  |
342 |  |  |  |  | use List::MoreUtils qw(any all none notall true false firstidx first_index
343 |  |  |  |  | lastidx last_index insert_after insert_after_string
344 |  |  |  |  | apply after after_incl before before_incl indexes
345 |  |  |  |  | firstval first_value lastval last_value each_array
346 |  |  |  |  | each_arrayref pairwise natatime mesh zip uniq minmax);
347 |  |  |  |  |
348 |  |  |  |  | =head1 DESCRIPTION
349 |  |  |  |  |
350 |  |  |  |  | C<List::MoreUtils> provides some trivial but commonly needed functionality on lists
351 |  |  |  |  | which is not going to go into C<List::Util>.
352 |  |  |  |  |
353 |  |  |  |  | All of the below functions are implementable in only a couple of lines of Perl
354 |  |  |  |  | code. Using the functions from this module however should give slightly better
355 |  |  |  |  | performance as everything is implemented in C. The pure-Perl implementation of
356 |  |  |  |  | these functions only serves as a fallback in case the C portions of this module
357 |  |  |  |  | couldn't be compiled on this machine.
358 |  |  |  |  |
359 |  |  |  |  | =over 4
360 |  |  |  |  |
361 |  |  |  |  | =item any BLOCK LIST
362 |  |  |  |  |
363 |  |  |  |  | Returns a true value if any item in LIST meets the criterion given through
364 |  |  |  |  | BLOCK. Sets C<$_> for each item in LIST in turn:
365 |  |  |  |  |
366 |  |  |  |  | print "At least one value undefined"
367 |  |  |  |  | if any { !defined($_) } @list;
368 |  |  |  |  |
369 |  |  |  |  | Returns false otherwise, or C<undef> if LIST is empty.
370 |  |  |  |  |
371 |  |  |  |  | =item all BLOCK LIST
372 |  |  |  |  |
373 |  |  |  |  | Returns a true value if all items in LIST meet the criterion given through
374 |  |  |  |  | BLOCK. Sets C<$_> for each item in LIST in turn:
375 |  |  |  |  |
376 |  |  |  |  | print "All items defined"
377 |  |  |  |  | if all { defined($_) } @list;
378 |  |  |  |  |
379 |  |  |  |  | Returns false otherwise, or C<undef> if LIST is empty.
380 |  |  |  |  |
381 |  |  |  |  | =item none BLOCK LIST
382 |  |  |  |  |
383 |  |  |  |  | Logically the negation of C<any>. Returns a true value if no item in LIST meets the
384 |  |  |  |  | criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
385 |  |  |  |  |
386 |  |  |  |  | print "No value defined"
387 |  |  |  |  | if none { defined($_) } @list;
388 |  |  |  |  |
389 |  |  |  |  | Returns false otherwise, or C<undef> if LIST is empty.
390 |  |  |  |  |
391 |  |  |  |  | =item notall BLOCK LIST
392 |  |  |  |  |
393 |  |  |  |  | Logically the negation of C<all>. Returns a true value if not all items in LIST meet
394 |  |  |  |  | the criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
395 |  |  |  |  |
396 |  |  |  |  | print "Not all values defined"
397 |  |  |  |  | if notall { defined($_) } @list;
398 |  |  |  |  |
399 |  |  |  |  | Returns false otherwise, or C<undef> if LIST is empty.
400 |  |  |  |  |
401 |  |  |  |  | =item true BLOCK LIST
402 |  |  |  |  |
403 |  |  |  |  | Counts the number of elements in LIST for which the criterion in BLOCK is true. Sets C<$_> for
404 |  |  |  |  | each item in LIST in turn:
405 |  |  |  |  |
406 |  |  |  |  | printf "%i item(s) are defined", true { defined($_) } @list;
407 |  |  |  |  |
408 |  |  |  |  | =item false BLOCK LIST
409 |  |  |  |  |
410 |  |  |  |  | Counts the number of elements in LIST for which the criterion in BLOCK is false. Sets C<$_> for
411 |  |  |  |  | each item in LIST in turn:
412 |  |  |  |  |
413 |  |  |  |  | printf "%i item(s) are not defined", false { defined($_) } @list;
414 |  |  |  |  |
415 |  |  |  |  | =item firstidx BLOCK LIST
416 |  |  |  |  |
417 |  |  |  |  | =item first_index BLOCK LIST
418 |  |  |  |  |
419 |  |  |  |  | Returns the index of the first element in LIST for which the criterion in BLOCK is true. Sets C<$_>
420 |  |  |  |  | for each item in LIST in turn:
421 |  |  |  |  |
422 |  |  |  |  | my @list = (1, 4, 3, 2, 4, 6);
423 |  |  |  |  | printf "item with index %i in list is 4", firstidx { $_ == 4 } @list;
424 |  |  |  |  | __END__
425 |  |  |  |  | item with index 1 in list is 4
426 |  |  |  |  |
427 |  |  |  |  | Returns C<-1> if no such item could be found.
428 |  |  |  |  |
429 |  |  |  |  | C<first_index> is an alias for C<firstidx>.
430 |  |  |  |  |
431 |  |  |  |  | =item lastidx BLOCK LIST
432 |  |  |  |  |
433 |  |  |  |  | =item last_index BLOCK LIST
434 |  |  |  |  |
435 |  |  |  |  | Returns the index of the last element in LIST for which the criterion in BLOCK is true. Sets C<$_>
436 |  |  |  |  | for each item in LIST in turn:
437 |  |  |  |  |
438 |  |  |  |  | my @list = (1, 4, 3, 2, 4, 6);
439 |  |  |  |  | printf "item with index %i in list is 4", lastidx { $_ == 4 } @list;
440 |  |  |  |  | __END__
441 |  |  |  |  | item with index 4 in list is 4
442 |  |  |  |  |
443 |  |  |  |  | Returns C<-1> if no such item could be found.
444 |  |  |  |  |
445 |  |  |  |  | C<last_index> is an alias for C<lastidx>.
446 |  |  |  |  |
447 |  |  |  |  | =item insert_after BLOCK VALUE LIST
448 |  |  |  |  |
449 |  |  |  |  | Inserts VALUE after the first item in LIST for which the criterion in BLOCK is true. Sets C<$_> for
450 |  |  |  |  | each item in LIST in turn.
451 |  |  |  |  |
452 |  |  |  |  | my @list = qw/This is a list/;
453 |  |  |  |  | insert_after { $_ eq "a" } "longer" => @list;
454 |  |  |  |  | print "@list";
455 |  |  |  |  | __END__
456 |  |  |  |  | This is a longer list
457 |  |  |  |  |
458 |  |  |  |  | =item insert_after_string STRING VALUE LIST
459 |  |  |  |  |
460 |  |  |  |  | Inserts VALUE after the first item in LIST which is equal to STRING.
461 |  |  |  |  |
462 |  |  |  |  | my @list = qw/This is a list/;
463 |  |  |  |  | insert_after_string "a", "longer" => @list;
464 |  |  |  |  | print "@list";
465 |  |  |  |  | __END__
466 |  |  |  |  | This is a longer list
467 |  |  |  |  |
468 |  |  |  |  | =item apply BLOCK LIST
469 |  |  |  |  |
470 |  |  |  |  | Applies BLOCK to each item in LIST and returns a list of the values after BLOCK
471 |  |  |  |  | has been applied. In scalar context, the last element is returned. This
472 |  |  |  |  | function is similar to C<map> but will not modify the elements of the input
473 |  |  |  |  | list:
474 |  |  |  |  |
475 |  |  |  |  | my @list = (1 .. 4);
476 |  |  |  |  | my @mult = apply { $_ *= 2 } @list;
477 |  |  |  |  | print "\@list = @list\n";
478 |  |  |  |  | print "\@mult = @mult\n";
479 |  |  |  |  | __END__
480 |  |  |  |  | @list = 1 2 3 4
481 |  |  |  |  | @mult = 2 4 6 8
482 |  |  |  |  |
483 |  |  |  |  | Think of it as syntactic sugar for
484 |  |  |  |  |
485 |  |  |  |  | for (my @mult = @list) { $_ *= 2 }
486 |  |  |  |  |
487 |  |  |  |  | =item after BLOCK LIST
488 |  |  |  |  |
489 |  |  |  |  | Returns a list of the values of LIST after (and not including) the point
490 |  |  |  |  | where BLOCK returns a true value. Sets C<$_> for each element in LIST in turn.
491 |  |  |  |  |
492 |  |  |  |  | @x = after { $_ % 5 == 0 } (1..9); # returns 6, 7, 8, 9
493 |  |  |  |  |
494 |  |  |  |  | =item after_incl BLOCK LIST
495 |  |  |  |  |
496 |  |  |  |  | Same as C<after> but also inclues the element for which BLOCK is true.
497 |  |  |  |  |
498 |  |  |  |  | =item before BLOCK LIST
499 |  |  |  |  |
500 |  |  |  |  | Returns a list of values of LIST upto (and not including) the point where BLOCK
501 |  |  |  |  | returns a true value. Sets C<$_> for each element in LIST in turn.
502 |  |  |  |  |
503 |  |  |  |  | =item before_incl BLOCK LIST
504 |  |  |  |  |
505 |  |  |  |  | Same as C<before> but also includes the element for which BLOCK is true.
506 |  |  |  |  |
507 |  |  |  |  | =item indexes BLOCK LIST
508 |  |  |  |  |
509 |  |  |  |  | Evaluates BLOCK for each element in LIST (assigned to C<$_>) and returns a list
510 |  |  |  |  | of the indices of those elements for which BLOCK returned a true value. This is
511 |  |  |  |  | just like C<grep> only that it returns indices instead of values:
512 |  |  |  |  |
513 |  |  |  |  | @x = indexes { $_ % 2 == 0 } (1..10); # returns 1, 3, 5, 7, 9
514 |  |  |  |  |
515 |  |  |  |  | =item firstval BLOCK LIST
516 |  |  |  |  |
517 |  |  |  |  | =item first_value BLOCK LIST
518 |  |  |  |  |
519 |  |  |  |  | Returns the first element in LIST for which BLOCK evaluates to true. Each
520 |  |  |  |  | element of LIST is set to C<$_> in turn. Returns C<undef> if no such element
521 |  |  |  |  | has been found.
522 |  |  |  |  |
523 |  |  |  |  | C<first_val> is an alias for C<firstval>.
524 |  |  |  |  |
525 |  |  |  |  | =item lastval BLOCK LIST
526 |  |  |  |  |
527 |  |  |  |  | =item last_value BLOCK LIST
528 |  |  |  |  |
529 |  |  |  |  | Returns the last value in LIST for which BLOCK evaluates to true. Each element
530 |  |  |  |  | of LIST is set to C<$_> in turn. Returns C<undef> if no such element has been
531 |  |  |  |  | found.
532 |  |  |  |  |
533 |  |  |  |  | C<last_val> is an alias for C<lastval>.
534 |  |  |  |  |
535 |  |  |  |  | =item pairwise BLOCK ARRAY1 ARRAY2
536 |  |  |  |  |
537 |  |  |  |  | Evaluates BLOCK for each pair of elements in ARRAY1 and ARRAY2 and returns a
538 |  |  |  |  | new list consisting of BLOCK's return values. The two elements are set to C<$a>
539 |  |  |  |  | and C<$b>. Note that those two are aliases to the original value so changing
540 |  |  |  |  | them will modify the input arrays.
541 |  |  |  |  |
542 |  |  |  |  | @a = (1 .. 5);
543 |  |  |  |  | @b = (11 .. 15);
544 |  |  |  |  | @x = pairwise { $a + $b } @a, @b; # returns 12, 14, 16, 18, 20
545 |  |  |  |  |
546 |  |  |  |  | # mesh with pairwise
547 |  |  |  |  | @a = qw/a b c/;
548 |  |  |  |  | @b = qw/1 2 3/;
549 |  |  |  |  | @x = pairwise { ($a, $b) } @a, @b; # returns a, 1, b, 2, c, 3
550 |  |  |  |  |
551 |  |  |  |  | =item each_array ARRAY1 ARRAY2 ...
552 |  |  |  |  |
553 |  |  |  |  | Creates an array iterator to return the elements of the list of arrays ARRAY1,
554 |  |  |  |  | ARRAY2 throughout ARRAYn in turn. That is, the first time it is called, it
555 |  |  |  |  | returns the first element of each array. The next time, it returns the second
556 |  |  |  |  | elements. And so on, until all elements are exhausted.
557 |  |  |  |  |
558 |  |  |  |  | This is useful for looping over more than one array at once:
559 |  |  |  |  |
560 |  |  |  |  | my $ea = each_array(@a, @b, @c);
561 |  |  |  |  | while ( my ($a, $b, $c) = $ea->() ) { .... }
562 |  |  |  |  |
563 |  |  |  |  | The iterator returns the empty list when it reached the end of all arrays.
564 |  |  |  |  |
565 |  |  |  |  | If the iterator is passed an argument of 'C<index>', then it retuns
566 |  |  |  |  | the index of the last fetched set of values, as a scalar.
567 |  |  |  |  |
568 |  |  |  |  | =item each_arrayref LIST
569 |  |  |  |  |
570 |  |  |  |  | Like each_array, but the arguments are references to arrays, not the
571 |  |  |  |  | plain arrays.
572 |  |  |  |  |
573 |  |  |  |  | =item natatime BLOCK LIST
574 |  |  |  |  |
575 |  |  |  |  | Creates an array iterator, for looping over an array in chunks of
576 |  |  |  |  | C<$n> items at a time. (n at a time, get it?). An example is
577 |  |  |  |  | probably a better explanation than I could give in words.
578 |  |  |  |  |
579 |  |  |  |  | Example:
580 |  |  |  |  |
581 |  |  |  |  | my @x = ('a' .. 'g');
582 |  |  |  |  | my $it = natatime 3, @x;
583 |  |  |  |  | while (my @vals = $it->())
584 |  |  |  |  | {
585 |  |  |  |  | print "@vals\n";
586 |  |  |  |  | }
587 |  |  |  |  |
588 |  |  |  |  | This prints
589 |  |  |  |  |
590 |  |  |  |  | a b c
591 |  |  |  |  | d e f
592 |  |  |  |  | g
593 |  |  |  |  |
594 |  |  |  |  | =item mesh ARRAY1 ARRAY2 [ ARRAY3 ... ]
595 |  |  |  |  |
596 |  |  |  |  | =item zip ARRAY1 ARRAY2 [ ARRAY3 ... ]
597 |  |  |  |  |
598 |  |  |  |  | Returns a list consisting of the first elements of each array, then
599 |  |  |  |  | the second, then the third, etc, until all arrays are exhausted.
600 |  |  |  |  |
601 |  |  |  |  | Examples:
602 |  |  |  |  |
603 |  |  |  |  | @x = qw/a b c d/;
604 |  |  |  |  | @y = qw/1 2 3 4/;
605 |  |  |  |  | @z = mesh @x, @y; # returns a, 1, b, 2, c, 3, d, 4
606 |  |  |  |  |
607 |  |  |  |  | @a = ('x');
608 |  |  |  |  | @b = ('1', '2');
609 |  |  |  |  | @c = qw/zip zap zot/;
610 |  |  |  |  | @d = mesh @a, @b, @c; # x, 1, zip, undef, 2, zap, undef, undef, zot
611 |  |  |  |  |
612 |  |  |  |  | C<zip> is an alias for C<mesh>.
613 |  |  |  |  |
614 |  |  |  |  | =item uniq LIST
615 |  |  |  |  |
616 |  |  |  |  | Returns a new list by stripping duplicate values in LIST. The order of
617 |  |  |  |  | elements in the returned list is the same as in LIST. In scalar context,
618 |  |  |  |  | returns the number of unique elements in LIST.
619 |  |  |  |  |
620 |  |  |  |  | my @x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 1 2 3 5 4
621 |  |  |  |  | my $x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 5
622 |  |  |  |  |
623 |  |  |  |  | =item minmax LIST
624 |  |  |  |  |
625 |  |  |  |  | Calculates the minimum and maximum of LIST and returns a two element list with
626 |  |  |  |  | the first element being the minimum and the second the maximum. Returns the empty
627 |  |  |  |  | list if LIST was empty.
628 |  |  |  |  |
629 |  |  |  |  | The minmax algorithm differs from a naive iteration over the list where each element
630 |  |  |  |  | is compared to two values being the so far calculated min and max value in that it
631 |  |  |  |  | only requires 3n/2 - 2 comparisons. Thus it is the most efficient possible algorithm.
632 |  |  |  |  |
633 |  |  |  |  | However, the Perl implementation of it has some overhead simply due to the fact
634 |  |  |  |  | that there are more lines of Perl code involved. Therefore, LIST needs to be
635 |  |  |  |  | fairly big in order for minmax to win over a naive implementation. This
636 |  |  |  |  | limitation does not apply to the XS version.
637 |  |  |  |  |
638 |  |  |  |  | =item part BLOCK LIST
639 |  |  |  |  |
640 |  |  |  |  | Partitions LIST based on the return value of BLOCK which denotes into which partition
641 |  |  |  |  | the current value is put.
642 |  |  |  |  |
643 |  |  |  |  | Returns a list of the partitions thusly created. Each partition created is a
644 |  |  |  |  | reference to an array.
645 |  |  |  |  |
646 |  |  |  |  | my $i = 0;
647 |  |  |  |  | my @part = part { $i++ % 2 } 1 .. 8; # returns [1, 3, 5, 7], [2, 4, 6, 8]
648 |  |  |  |  |
649 |  |  |  |  | You can have a sparse list of partitions as well where non-set partitions will
650 |  |  |  |  | be undef:
651 |  |  |  |  |
652 |  |  |  |  | my @part = part { 2 } 1 .. 10; # returns undef, undef, [ 1 .. 10 ]
653 |  |  |  |  |
654 |  |  |  |  | Be careful with negative values, though:
655 |  |  |  |  |
656 |  |  |  |  | my @part = part { -1 } 1 .. 10;
657 |  |  |  |  | __END__
658 |  |  |  |  | Modification of non-creatable array value attempted, subscript -1 ...
659 |  |  |  |  |
660 |  |  |  |  | Negative values are only ok when they refer to a partition previously created:
661 |  |  |  |  |
662 |  |  |  |  | my @idx = (0, 1, -1);
663 |  |  |  |  | my $i = 0;
664 |  |  |  |  | my @part = part { $idx[$++ % 3] } 1 .. 8; # [1, 4, 7], [2, 3, 5, 6, 8]
665 |  |  |  |  |
666 |  |  |  |  | =back
667 |  |  |  |  |
668 |  |  |  |  | =head1 EXPORTS
669 |  |  |  |  |
670 |  |  |  |  | Nothing by default. To import all of this module's symbols, do the conventional
671 |  |  |  |  |
672 |  |  |  |  | use List::MoreUtils qw/:all/;
673 |  |  |  |  |
674 |  |  |  |  | It may make more sense though to only import the stuff your program actually needs:
675 |  |  |  |  |
676 |  |  |  |  | use List::MoreUtils qw/any firstidx/;
677 |  |  |  |  |
678 |  |  |  |  | =head1 ENVIRONMENT
679 |  |  |  |  |
680 |  |  |  |  | When C<LIST_MOREUTILS_PP> is set, the module will always use the pure-Perl
681 |  |  |  |  | implementation and not the XS one. This environment variable is really just
682 |  |  |  |  | there for the test-suite to force testing the Perl implementation, and possibly
683 |  |  |  |  | for reporting of bugs. I don't see any reason to use it in a production
684 |  |  |  |  | environment.
685 |  |  |  |  |
686 |  |  |  |  | =head1 VERSION
687 |  |  |  |  |
688 |  |  |  |  | This is version 0.22.
689 |  |  |  |  |
690 |  |  |  |  | =head1 BUGS
691 |  |  |  |  |
692 |  |  |  |  | There is a problem with a bug in 5.6.x perls. It is a syntax error to write
693 |  |  |  |  | things like:
694 |  |  |  |  |
695 |  |  |  |  | my @x = apply { s/foo/bar/ } qw/foo bar baz/;
696 |  |  |  |  |
697 |  |  |  |  | It has to be written as either
698 |  |  |  |  |
699 |  |  |  |  | my @x = apply { s/foo/bar/ } 'foo', 'bar', 'baz';
700 |  |  |  |  |
701 |  |  |  |  | or
702 |  |  |  |  |
703 |  |  |  |  | my @x = apply { s/foo/bar/ } my @dummy = qw/foo bar baz/;
704 |  |  |  |  |
705 |  |  |  |  | Perl5.5.x and perl5.8.x don't suffer from this limitation.
706 |  |  |  |  |
707 |  |  |  |  | If you have a functionality that you could imagine being in this module, please
708 |  |  |  |  | drop me a line. This module's policy will be less strict than C<List::Util>'s when
709 |  |  |  |  | it comes to additions as it isn't a core module.
710 |  |  |  |  |
711 |  |  |  |  | When you report bugs, it would be nice if you could additionally give me the
712 |  |  |  |  | output of your program with the environment variable C<LIST_MOREUTILS_PP> set
713 |  |  |  |  | to a true value. That way I know where to look for the problem (in XS,
714 |  |  |  |  | pure-Perl or possibly both).
715 |  |  |  |  |
716 |  |  |  |  | =head1 THANKS
717 |  |  |  |  |
718 |  |  |  |  | Credits go to a number of people: Steve Purkis for giving me namespace advice
719 |  |  |  |  | and James Keenan and Terrence Branno for their effort of keeping the CPAN
720 |  |  |  |  | tidier by making List::Utils obsolete.
721 |  |  |  |  |
722 |  |  |  |  | Brian McCauley suggested the inclusion of apply() and provided the pure-Perl
723 |  |  |  |  | implementation for it.
724 |  |  |  |  |
725 |  |  |  |  | Eric J. Roode asked me to add all functions from his module C<List::MoreUtil>
726 |  |  |  |  | into this one. With minor modifications, the pure-Perl implementations of those
727 |  |  |  |  | are by him.
728 |  |  |  |  |
729 |  |  |  |  | The bunch of people who almost immediately pointed out the many problems with
730 |  |  |  |  | the glitchy 0.07 release (Slaven Rezic, Ron Savage, CPAN testers).
731 |  |  |  |  |
732 |  |  |  |  | A particularly nasty memory leak was spotted by Thomas A. Lowery.
733 |  |  |  |  |
734 |  |  |  |  | Lars Thegler made me aware of problems with older Perl versions.
735 |  |  |  |  |
736 |  |  |  |  | Anno Siegel de-orphaned each_arrayref().
737 |  |  |  |  |
738 |  |  |  |  | David Filmer made me aware of a problem in each_arrayref that could ultimately
739 |  |  |  |  | lead to a segfault.
740 |  |  |  |  |
741 |  |  |  |  | Ricardo Signes suggested the inclusion of part() and provided the
742 |  |  |  |  | Perl-implementation.
743 |  |  |  |  |
744 |  |  |  |  | Robin Huston kindly fixed a bug in perl's MULTICALL API to make the
745 |  |  |  |  | XS-implementation of part() work.
746 |  |  |  |  |
747 |  |  |  |  | =head1 TODO
748 |  |  |  |  |
749 |  |  |  |  | A pile of requests from other people is still pending further processing in my
750 |  |  |  |  | mailbox. This includes:
751 |  |  |  |  |
752 |  |  |  |  | =over 4
753 |  |  |  |  |
754 |  |  |  |  | =item * uniq_by(&@)
755 |  |  |  |  |
756 |  |  |  |  | Use code-reference to extract a key based on which the uniqueness is
757 |  |  |  |  | determined. Suggested by Aaron Crane.
758 |  |  |  |  |
759 |  |  |  |  | =item * delete_index
760 |  |  |  |  |
761 |  |  |  |  | =item * random_item
762 |  |  |  |  |
763 |  |  |  |  | =item * random_item_delete_index
764 |  |  |  |  |
765 |  |  |  |  | =item * list_diff_hash
766 |  |  |  |  |
767 |  |  |  |  | =item * list_diff_inboth
768 |  |  |  |  |
769 |  |  |  |  | =item * list_diff_infirst
770 |  |  |  |  |
771 |  |  |  |  | =item * list_diff_insecond
772 |  |  |  |  |
773 |  |  |  |  | These were all suggested by Dan Muey.
774 |  |  |  |  |
775 |  |  |  |  | =item * listify
776 |  |  |  |  |
777 |  |  |  |  | Always return a flat list when either a simple scalar value was passed or an array-reference.
778 |  |  |  |  | Suggested by Mark Summersault.
779 |  |  |  |  |
780 |  |  |  |  | =back
781 |  |  |  |  |
782 |  |  |  |  | =head1 SEE ALSO
783 |  |  |  |  |
784 |  |  |  |  | L<List::Util>
785 |  |  |  |  |
786 |  |  |  |  | =head1 AUTHOR
787 |  |  |  |  |
788 |  |  |  |  | Tassilo von Parseval, E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
789 |  |  |  |  |
790 |  |  |  |  | =head1 COPYRIGHT AND LICENSE
791 |  |  |  |  |
792 |  |  |  |  | Copyright (C) 2004-2006 by Tassilo von Parseval
793 |  |  |  |  |
794 |  |  |  |  | This library is free software; you can redistribute it and/or modify
795 |  |  |  |  | it under the same terms as Perl itself, either Perl version 5.8.4 or,
796 |  |  |  |  | at your option, any later version of Perl 5 you may have available.
797 |  |  |  |  |
798 |  |  |  |  | =cut
|  |  |  |  | # spent 267µs (220+47) within List::MoreUtils::all which was called 49 times, avg 5µs/call: # 28 times (47µs+0s) by Moose::Util::TypeConstraints::subtype at line 308 of Moose/Util/TypeConstraints.pm, avg 2µs/call # 20 times (73µs+14µs) by Moose::Util::TypeConstraints::subtype at line 302 of Moose/Util/TypeConstraints.pm, avg 4µs/call # once (100µs+33µs) by Moose::Meta::Class::_reconcile_with_superclass_meta at line 406 of Moose/Meta/Class.pm sub List::MoreUtils::all; # xsub
|  |  |  |  | # spent 31µs (30+1) within List::MoreUtils::any which was called # once (30µs+1µs) by Moose::Util::TypeConstraints::type at line 277 of Moose/Util/TypeConstraints.pm sub List::MoreUtils::any; # xsub
|  |  |  |  | # spent 64µs within List::MoreUtils::bootstrap which was called # once (64µs+0s) by DynaLoader::bootstrap at line 227 of DynaLoader.pm sub List::MoreUtils::bootstrap; # xsub
|  |  |  |  | # spent 267µs within List::MoreUtils::firstidx which was called 118 times, avg 2µs/call: # 59 times (194µs+0s) by Moose::Exporter::_strip_traits at line 393 of Moose/Exporter.pm, avg 3µs/call # 59 times (72µs+0s) by Moose::Exporter::_strip_metaclass at line 407 of Moose/Exporter.pm, avg 1µs/call sub List::MoreUtils::firstidx; # xsub
|  |  |  |  | # spent 32µs within List::MoreUtils::uniq which was called 5 times, avg 6µs/call: # 5 times (32µs+0s) by Moose::Exporter::_follow_also at line 100 of Moose/Exporter.pm, avg 6µs/call sub List::MoreUtils::uniq; # xsub