← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:31 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/List/MoreUtils/PP.pm
StatementsExecuted 22 statements in 5.45ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11157µs57µsList::MoreUtils::PP::::BEGIN@3List::MoreUtils::PP::BEGIN@3
11119µs240µsList::MoreUtils::PP::::BEGIN@413List::MoreUtils::PP::BEGIN@413
11117µs30µsList::MoreUtils::PP::::BEGIN@870List::MoreUtils::PP::BEGIN@870
11112µs20µsList::MoreUtils::PP::::BEGIN@129List::MoreUtils::PP::BEGIN@129
11111µs19µsList::MoreUtils::PP::::BEGIN@4List::MoreUtils::PP::BEGIN@4
11110µs21µsList::MoreUtils::PP::::BEGIN@421List::MoreUtils::PP::BEGIN@421
1119µs14µsList::MoreUtils::PP::::BEGIN@154List::MoreUtils::PP::BEGIN@154
1119µs60µsList::MoreUtils::PP::::BEGIN@5List::MoreUtils::PP::BEGIN@5
1116µs9µsList::MoreUtils::PP::::BEGIN@179List::MoreUtils::PP::BEGIN@179
0000s0sList::MoreUtils::PP::::_XScompiledList::MoreUtils::PP::_XScompiled
0000s0sList::MoreUtils::PP::::__ANON__[:345]List::MoreUtils::PP::__ANON__[:345]
0000s0sList::MoreUtils::PP::::__ANON__[:487]List::MoreUtils::PP::__ANON__[:487]
0000s0sList::MoreUtils::PP::::__ANON__[:494]List::MoreUtils::PP::__ANON__[:494]
0000s0sList::MoreUtils::PP::::__ANON__[:501]List::MoreUtils::PP::__ANON__[:501]
0000s0sList::MoreUtils::PP::::__ANON__[:892]List::MoreUtils::PP::__ANON__[:892]
0000s0sList::MoreUtils::PP::::__ANON__[:893]List::MoreUtils::PP::__ANON__[:893]
0000s0sList::MoreUtils::PP::::afterList::MoreUtils::PP::after
0000s0sList::MoreUtils::PP::::after_inclList::MoreUtils::PP::after_incl
0000s0sList::MoreUtils::PP::::allList::MoreUtils::PP::all
0000s0sList::MoreUtils::PP::::all_uList::MoreUtils::PP::all_u
0000s0sList::MoreUtils::PP::::anyList::MoreUtils::PP::any
0000s0sList::MoreUtils::PP::::any_uList::MoreUtils::PP::any_u
0000s0sList::MoreUtils::PP::::applyList::MoreUtils::PP::apply
0000s0sList::MoreUtils::PP::::arrayifyList::MoreUtils::PP::arrayify
0000s0sList::MoreUtils::PP::::beforeList::MoreUtils::PP::before
0000s0sList::MoreUtils::PP::::before_inclList::MoreUtils::PP::before_incl
0000s0sList::MoreUtils::PP::::binsertList::MoreUtils::PP::binsert
0000s0sList::MoreUtils::PP::::bremoveList::MoreUtils::PP::bremove
0000s0sList::MoreUtils::PP::::bsearchList::MoreUtils::PP::bsearch
0000s0sList::MoreUtils::PP::::bsearchidxList::MoreUtils::PP::bsearchidx
0000s0sList::MoreUtils::PP::::duplicatesList::MoreUtils::PP::duplicates
0000s0sList::MoreUtils::PP::::each_arrayList::MoreUtils::PP::each_array
0000s0sList::MoreUtils::PP::::each_arrayrefList::MoreUtils::PP::each_arrayref
0000s0sList::MoreUtils::PP::::equal_rangeList::MoreUtils::PP::equal_range
0000s0sList::MoreUtils::PP::::falseList::MoreUtils::PP::false
0000s0sList::MoreUtils::PP::::firstidxList::MoreUtils::PP::firstidx
0000s0sList::MoreUtils::PP::::firstresList::MoreUtils::PP::firstres
0000s0sList::MoreUtils::PP::::firstvalList::MoreUtils::PP::firstval
0000s0sList::MoreUtils::PP::::frequencyList::MoreUtils::PP::frequency
0000s0sList::MoreUtils::PP::::indexesList::MoreUtils::PP::indexes
0000s0sList::MoreUtils::PP::::insert_afterList::MoreUtils::PP::insert_after
0000s0sList::MoreUtils::PP::::insert_after_stringList::MoreUtils::PP::insert_after_string
0000s0sList::MoreUtils::PP::::lastidxList::MoreUtils::PP::lastidx
0000s0sList::MoreUtils::PP::::lastresList::MoreUtils::PP::lastres
0000s0sList::MoreUtils::PP::::lastvalList::MoreUtils::PP::lastval
0000s0sList::MoreUtils::PP::::listcmpList::MoreUtils::PP::listcmp
0000s0sList::MoreUtils::PP::::lower_boundList::MoreUtils::PP::lower_bound
0000s0sList::MoreUtils::PP::::meshList::MoreUtils::PP::mesh
0000s0sList::MoreUtils::PP::::minmaxList::MoreUtils::PP::minmax
0000s0sList::MoreUtils::PP::::minmaxstrList::MoreUtils::PP::minmaxstr
0000s0sList::MoreUtils::PP::::modeList::MoreUtils::PP::mode
0000s0sList::MoreUtils::PP::::natatimeList::MoreUtils::PP::natatime
0000s0sList::MoreUtils::PP::::noneList::MoreUtils::PP::none
0000s0sList::MoreUtils::PP::::none_uList::MoreUtils::PP::none_u
0000s0sList::MoreUtils::PP::::notallList::MoreUtils::PP::notall
0000s0sList::MoreUtils::PP::::notall_uList::MoreUtils::PP::notall_u
0000s0sList::MoreUtils::PP::::nsort_byList::MoreUtils::PP::nsort_by
0000s0sList::MoreUtils::PP::::occurrencesList::MoreUtils::PP::occurrences
0000s0sList::MoreUtils::PP::::oneList::MoreUtils::PP::one
0000s0sList::MoreUtils::PP::::one_uList::MoreUtils::PP::one_u
0000s0sList::MoreUtils::PP::::onlyidxList::MoreUtils::PP::onlyidx
0000s0sList::MoreUtils::PP::::onlyresList::MoreUtils::PP::onlyres
0000s0sList::MoreUtils::PP::::onlyvalList::MoreUtils::PP::onlyval
0000s0sList::MoreUtils::PP::::pairwiseList::MoreUtils::PP::pairwise
0000s0sList::MoreUtils::PP::::partList::MoreUtils::PP::part
0000s0sList::MoreUtils::PP::::qsortList::MoreUtils::PP::qsort
0000s0sList::MoreUtils::PP::::reduce_0List::MoreUtils::PP::reduce_0
0000s0sList::MoreUtils::PP::::reduce_1List::MoreUtils::PP::reduce_1
0000s0sList::MoreUtils::PP::::reduce_uList::MoreUtils::PP::reduce_u
0000s0sList::MoreUtils::PP::::samplesList::MoreUtils::PP::samples
0000s0sList::MoreUtils::PP::::singletonList::MoreUtils::PP::singleton
0000s0sList::MoreUtils::PP::::slideList::MoreUtils::PP::slide
0000s0sList::MoreUtils::PP::::slideatatimeList::MoreUtils::PP::slideatatime
0000s0sList::MoreUtils::PP::::sort_byList::MoreUtils::PP::sort_by
0000s0sList::MoreUtils::PP::::trueList::MoreUtils::PP::true
0000s0sList::MoreUtils::PP::::uniqList::MoreUtils::PP::uniq
0000s0sList::MoreUtils::PP::::upper_boundList::MoreUtils::PP::upper_bound
0000s0sList::MoreUtils::PP::::zip6List::MoreUtils::PP::zip6
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package List::MoreUtils::PP;
2
3258µs157µs
# spent 57µs within List::MoreUtils::PP::BEGIN@3 which was called: # once (57µs+0s) by List::MoreUtils::BEGIN@21 at line 3
use 5.008_001;
# spent 57µs making 1 call to List::MoreUtils::PP::BEGIN@3
4241µs227µs
# spent 19µs (11+8) within List::MoreUtils::PP::BEGIN@4 which was called: # once (11µs+8µs) by List::MoreUtils::BEGIN@21 at line 4
use strict;
# spent 19µs making 1 call to List::MoreUtils::PP::BEGIN@4 # spent 8µs making 1 call to strict::import
52451µs2111µs
# spent 60µs (9+51) within List::MoreUtils::PP::BEGIN@5 which was called: # once (9µs+51µs) by List::MoreUtils::BEGIN@21 at line 5
use warnings;
# spent 60µs making 1 call to List::MoreUtils::PP::BEGIN@5 # spent 51µs making 1 call to warnings::import
6
711µsour $VERSION = '0.430';
8
9=pod
10
11=head1 NAME
12
13List::MoreUtils::PP - Provide List::MoreUtils pure Perl implementation
14
15=head1 SYNOPSIS
16
17 BEGIN { $ENV{LIST_MOREUTILS_PP} = 1; }
18 use List::MoreUtils qw(:all);
19
20=cut
21
22## no critic (Subroutines::ProhibitSubroutinePrototypes, Subroutines::RequireArgUnpacking)
23## no critic (Subroutines::ProhibitManyArgs)
24
25sub any (&@)
26{
27 my $f = shift;
28 foreach (@_)
29 {
30 return 1 if $f->();
31 }
32 return 0;
33}
34
35sub all (&@)
36{
37 my $f = shift;
38 foreach (@_)
39 {
40 return 0 unless $f->();
41 }
42 return 1;
43}
44
45sub none (&@)
46{
47 my $f = shift;
48 foreach (@_)
49 {
50 return 0 if $f->();
51 }
52 return 1;
53}
54
55sub notall (&@)
56{
57 my $f = shift;
58 foreach (@_)
59 {
60 return 1 unless $f->();
61 }
62 return 0;
63}
64
65sub one (&@)
66{
67 my $f = shift;
68 my $found = 0;
69 foreach (@_)
70 {
71 $f->() and $found++ and return 0;
72 }
73 return $found;
74}
75
76sub any_u (&@)
77{
78 my $f = shift;
79 return if !@_;
80 $f->() and return 1 foreach (@_);
81 return 0;
82}
83
84sub all_u (&@)
85{
86 my $f = shift;
87 return if !@_;
88 $f->() or return 0 foreach (@_);
89 return 1;
90}
91
92sub none_u (&@)
93{
94 my $f = shift;
95 return if !@_;
96 $f->() and return 0 foreach (@_);
97 return 1;
98}
99
100sub notall_u (&@)
101{
102 my $f = shift;
103 return if !@_;
104 $f->() or return 1 foreach (@_);
105 return 0;
106}
107
108sub one_u (&@)
109{
110 my $f = shift;
111 return if !@_;
112 my $found = 0;
113 foreach (@_)
114 {
115 $f->() and $found++ and return 0;
116 }
117 return $found;
118}
119
120sub reduce_u(&@)
121{
122 my $code = shift;
123
124 # Localise $a, $b
125 my ($caller_a, $caller_b) = do
126 {
127 my $pkg = caller();
128 ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
1292149µs228µs
# spent 20µs (12+8) within List::MoreUtils::PP::BEGIN@129 which was called: # once (12µs+8µs) by List::MoreUtils::BEGIN@21 at line 129
no strict 'refs';
# spent 20µs making 1 call to List::MoreUtils::PP::BEGIN@129 # spent 8µs making 1 call to strict::unimport
130 \*{$pkg . '::a'}, \*{$pkg . '::b'};
131 };
132
133 ## no critic (Variables::RequireInitializationForLocalVars)
134 local (*$caller_a, *$caller_b);
135 *$caller_a = \();
136 for (0 .. $#_)
137 {
138 *$caller_b = \$_[$_];
139 *$caller_a = \($code->());
140 }
141
142 return ${*$caller_a};
143}
144
145sub reduce_0(&@)
146{
147 my $code = shift;
148
149 # Localise $a, $b
150 my ($caller_a, $caller_b) = do
151 {
152 my $pkg = caller();
153 ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
1542103µs219µs
# spent 14µs (9+5) within List::MoreUtils::PP::BEGIN@154 which was called: # once (9µs+5µs) by List::MoreUtils::BEGIN@21 at line 154
no strict 'refs';
# spent 14µs making 1 call to List::MoreUtils::PP::BEGIN@154 # spent 5µs making 1 call to strict::unimport
155 \*{$pkg . '::a'}, \*{$pkg . '::b'};
156 };
157
158 ## no critic (Variables::RequireInitializationForLocalVars)
159 local (*$caller_a, *$caller_b);
160 *$caller_a = \0;
161 for (0 .. $#_)
162 {
163 *$caller_b = \$_[$_];
164 *$caller_a = \($code->());
165 }
166
167 return ${*$caller_a};
168}
169
170sub reduce_1(&@)
171{
172 my $code = shift;
173
174 # Localise $a, $b
175 my ($caller_a, $caller_b) = do
176 {
177 my $pkg = caller();
178 ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
17921.23ms212µs
# spent 9µs (6+3) within List::MoreUtils::PP::BEGIN@179 which was called: # once (6µs+3µs) by List::MoreUtils::BEGIN@21 at line 179
no strict 'refs';
# spent 9µs making 1 call to List::MoreUtils::PP::BEGIN@179 # spent 3µs making 1 call to strict::unimport
180 \*{$pkg . '::a'}, \*{$pkg . '::b'};
181 };
182
183 ## no critic (Variables::RequireInitializationForLocalVars)
184 local (*$caller_a, *$caller_b);
185 *$caller_a = \1;
186 for (0 .. $#_)
187 {
188 *$caller_b = \$_[$_];
189 *$caller_a = \($code->());
190 }
191
192 return ${*$caller_a};
193}
194
195sub true (&@)
196{
197 my $f = shift;
198 my $count = 0;
199 $f->() and ++$count foreach (@_);
200 return $count;
201}
202
203sub false (&@)
204{
205 my $f = shift;
206 my $count = 0;
207 $f->() or ++$count foreach (@_);
208 return $count;
209}
210
211sub firstidx (&@)
212{
213 my $f = shift;
214 foreach my $i (0 .. $#_)
215 {
216 local *_ = \$_[$i];
217 return $i if $f->();
218 }
219 return -1;
220}
221
222sub firstval (&@)
223{
224 my $test = shift;
225 foreach (@_)
226 {
227 return $_ if $test->();
228 }
229 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
230 return undef;
231}
232
233sub firstres (&@)
234{
235 my $test = shift;
236 foreach (@_)
237 {
238 my $testval = $test->();
239 $testval and return $testval;
240 }
241 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
242 return undef;
243}
244
245sub onlyidx (&@)
246{
247 my $f = shift;
248 my $found;
249 foreach my $i (0 .. $#_)
250 {
251 local *_ = \$_[$i];
252 $f->() or next;
253 defined $found and return -1;
254 $found = $i;
255 }
256 return defined $found ? $found : -1;
257}
258
259sub onlyval (&@)
260{
261 my $test = shift;
262 my $result = undef;
263 my $found = 0;
264 foreach (@_)
265 {
266 $test->() or next;
267 $result = $_;
268 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
269 $found++ and return undef;
270 }
271 return $result;
272}
273
274sub onlyres (&@)
275{
276 my $test = shift;
277 my $result = undef;
278 my $found = 0;
279 foreach (@_)
280 {
281 my $rv = $test->() or next;
282 $result = $rv;
283 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
284 $found++ and return undef;
285 }
286 return $found ? $result : undef;
287}
288
289sub lastidx (&@)
290{
291 my $f = shift;
292 foreach my $i (reverse 0 .. $#_)
293 {
294 local *_ = \$_[$i];
295 return $i if $f->();
296 }
297 return -1;
298}
299
300sub lastval (&@)
301{
302 my $test = shift;
303 my $ix;
304 for ($ix = $#_; $ix >= 0; $ix--)
305 {
306 local *_ = \$_[$ix];
307 my $testval = $test->();
308
309 # Simulate $_ as alias
310 $_[$ix] = $_;
311 return $_ if $testval;
312 }
313 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
314 return undef;
315}
316
317sub lastres (&@)
318{
319 my $test = shift;
320 my $ix;
321 for ($ix = $#_; $ix >= 0; $ix--)
322 {
323 local *_ = \$_[$ix];
324 my $testval = $test->();
325
326 # Simulate $_ as alias
327 $_[$ix] = $_;
328 return $testval if $testval;
329 }
330 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
331 return undef;
332}
333
334sub insert_after (&$\@)
335{
336 my ($f, $val, $list) = @_;
337 my $c = &firstidx($f, @$list);
338 @$list = (@{$list}[0 .. $c], $val, @{$list}[$c + 1 .. $#$list],) and return 1 if $c != -1;
339 return 0;
340}
341
342sub insert_after_string ($$\@)
343{
344 my ($string, $val, $list) = @_;
345 my $c = firstidx { defined $_ and $string eq $_ } @$list;
346 @$list = (@{$list}[0 .. $c], $val, @{$list}[$c + 1 .. $#$list],) and return 1 if $c != -1;
347 return 0;
348}
349
350sub apply (&@)
351{
352 my $action = shift;
353 &$action foreach my @values = @_;
354 return wantarray ? @values : $values[-1];
355}
356
357sub after (&@)
358{
359 my $test = shift;
360 my $started;
361 my $lag;
362 ## no critic (BuiltinFunctions::RequireBlockGrep)
363 return grep $started ||= do
364 {
365 my $x = $lag;
366 $lag = $test->();
367 $x;
368 }, @_;
369}
370
371sub after_incl (&@)
372{
373 my $test = shift;
374 my $started;
375 return grep { $started ||= $test->() } @_;
376}
377
378sub before (&@)
379{
380 my $test = shift;
381 my $more = 1;
382 return grep { $more &&= !$test->() } @_;
383}
384
385sub before_incl (&@)
386{
387 my $test = shift;
388 my $more = 1;
389 my $lag = 1;
390 ## no critic (BuiltinFunctions::RequireBlockGrep)
391 return grep $more &&= do
392 {
393 my $x = $lag;
394 $lag = !$test->();
395 $x;
396 }, @_;
397}
398
399sub indexes (&@)
400{
401 my $test = shift;
402 return grep {
403 local *_ = \$_[$_];
404 $test->()
405 } 0 .. $#_;
406}
407
408sub pairwise (&\@\@)
409{
410 my $op = shift;
411
412 # Symbols for caller's input arrays
413279µs2461µs
# spent 240µs (19+221) within List::MoreUtils::PP::BEGIN@413 which was called: # once (19µs+221µs) by List::MoreUtils::BEGIN@21 at line 413
use vars qw{ @A @B };
# spent 240µs making 1 call to List::MoreUtils::PP::BEGIN@413 # spent 221µs making 1 call to vars::import
414 local (*A, *B) = @_;
415
416 # Localise $a, $b
417 my ($caller_a, $caller_b) = do
418 {
419 my $pkg = caller();
420 ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
42122.85ms232µs
# spent 21µs (10+11) within List::MoreUtils::PP::BEGIN@421 which was called: # once (10µs+11µs) by List::MoreUtils::BEGIN@21 at line 421
no strict 'refs';
# spent 21µs making 1 call to List::MoreUtils::PP::BEGIN@421 # spent 11µs making 1 call to strict::unimport
422 \*{$pkg . '::a'}, \*{$pkg . '::b'};
423 };
424
425 # Loop iteration limit
426 my $limit = $#A > $#B ? $#A : $#B;
427
428 ## no critic (Variables::RequireInitializationForLocalVars)
429 # This map expression is also the return value
430 local (*$caller_a, *$caller_b);
431 ## no critic (BuiltinFunctions::ProhibitComplexMappings)
432 return map {
433 # Assign to $a, $b as refs to caller's array elements
434 (*$caller_a, *$caller_b) = \($#A < $_ ? undef : $A[$_], $#B < $_ ? undef : $B[$_]);
435
436 # Perform the transformation
437 $op->();
438 } 0 .. $limit;
439}
440
441sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
442{
443 return each_arrayref(@_);
444}
445
446sub each_arrayref
447{
448 my @list = @_; # The list of references to the arrays
449 my $index = 0; # Which one the caller will get next
450 my $max = 0; # Number of elements in longest array
451
452 # Get the length of the longest input array
453 foreach (@list)
454 {
455 unless (ref $_ eq 'ARRAY')
456 {
457 require Carp;
458 Carp::croak("each_arrayref: argument is not an array reference\n");
459 }
460 $max = @$_ if @$_ > $max;
461 }
462
463 # Return the iterator as a closure wrt the above variables.
464 return sub {
465 if (@_)
466 {
467 my $method = shift;
468 unless ($method eq 'index')
469 {
470 require Carp;
471 Carp::croak("each_array: unknown argument '$method' passed to iterator.");
472 }
473
474 ## no critic (Subroutines::ProhibitExplicitReturnUndef)
475 return undef if $index == 0 || $index > $max;
476 # Return current (last fetched) index
477 return $index - 1;
478 }
479
480 # No more elements to return
481 return if $index >= $max;
482 my $i = $index++;
483
484 # Return ith elements
485 ## no critic (BuiltinFunctions::RequireBlockMap)
486 return map $_->[$i], @list;
487 }
488}
489
490sub natatime ($@)
491{
492 my $n = shift;
493 my @list = @_;
494 return sub { return splice @list, 0, $n; }
495}
496
497# "leaks" when lexically hidden in arrayify
49811µsmy $flatten;
499$flatten = sub {
500 return map { (ref $_ and ("ARRAY" eq ref $_ or overload::Method($_, '@{}'))) ? ($flatten->(@{$_})) : ($_) } @_;
50115µs};
502
503sub arrayify
504{
505 return map { $flatten->($_) } @_;
506}
507
508sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
509{
510 my $max = -1;
511 $max < $#$_ && ($max = $#$_) foreach @_;
512 ## no critic (BuiltinFunctions::ProhibitComplexMappings)
513 return map {
514 my $ix = $_;
515 ## no critic (BuiltinFunctions::RequireBlockMap)
516 map $_->[$ix], @_;
517 } 0 .. $max;
518}
519
520sub zip6 (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
521{
522 my $max = -1;
523 $max < $#$_ && ($max = $#$_) foreach @_;
524 ## no critic (BuiltinFunctions::ProhibitComplexMappings)
525 return map {
526 my $ix = $_;
527 ## no critic (BuiltinFunctions::RequireBlockMap)
528 [map $_->[$ix], @_];
529 } 0 .. $max;
530}
531
532sub listcmp (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
533{
534 my %ret;
535 for (my $i = 0; $i < scalar @_; ++$i)
536 {
537 my %seen;
538 my $k;
539 foreach my $w (grep { defined $_ and not $seen{$k = $_}++ } @{$_[$i]})
540 {
541 $ret{$w} ||= [];
542 push @{$ret{$w}}, $i;
543 }
544 }
545 return %ret;
546}
547
548sub uniq (@)
549{
550 my %seen = ();
551 my $k;
552 my $seen_undef;
553 return grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
554}
555
556sub singleton (@)
557{
558 my %seen = ();
559 my $k;
560 my $seen_undef;
561 return grep { 1 == (defined $_ ? $seen{$k = $_} : $seen_undef) }
562 grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
563}
564
565sub duplicates (@)
566{
567 my %seen = ();
568 my $k;
569 my $seen_undef;
570 return grep { 1 < (defined $_ ? $seen{$k = $_} : $seen_undef) }
571 grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
572}
573
574sub frequency (@)
575{
576 my %seen = ();
577 my $k;
578 my $seen_undef;
579 my %h = map { defined $_ ? ($_ => $seen{$k = $_}) : () }
580 grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
581 wantarray or return (scalar keys %h) + ($seen_undef ? 1 : 0);
582 undef $k;
583 return (%h, $seen_undef ? (\$k => $seen_undef) : ());
584}
585
586sub occurrences (@)
587{
588 my %seen = ();
589 my $k;
590 my $seen_undef;
591 my @ret;
592 foreach my $l (map { $_ } grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_)
593 {
594 my $n = defined $l ? $seen{$l} : $seen_undef;
595 defined $ret[$n] or $ret[$n] = [];
596 push @{$ret[$n]}, $l;
597 }
598 return @ret;
599}
600
601sub mode (@)
602{
603 my %seen = ();
604 my ($max, $k, $seen_undef) = (1);
605
606 foreach (@_) { defined $_ ? ($max < ++$seen{$k = $_} and ++$max) : ($max < ++$seen_undef and ++$max) }
607 wantarray or return $max;
608
609 my @ret = ($max);
610 foreach my $l (grep { $seen{$_} == $max } keys %seen)
611 {
612 push @ret, $l;
613 }
614 $seen_undef and $seen_undef == $max and push @ret, undef;
615 return @ret;
616}
617
618sub samples ($@)
619{
620 my $n = shift;
621 if ($n > @_)
622 {
623 require Carp;
624 Carp::croak(sprintf("Cannot get %d samples from %d elements", $n, scalar @_));
625 }
626
627 for (my $i = @_; @_ - $i > $n;)
628 {
629 my $idx = @_ - $i;
630 my $swp = $idx + int(rand(--$i));
631 my $xchg = $_[$swp];
632 $_[$swp] = $_[$idx];
633 $_[$idx] = $xchg;
634 }
635
636 return splice @_, 0, $n;
637}
638
639sub minmax (@)
640{
641 return unless @_;
642 my $min = my $max = $_[0];
643
644 for (my $i = 1; $i < @_; $i += 2)
645 {
646 if ($_[$i - 1] <= $_[$i])
647 {
648 $min = $_[$i - 1] if $min > $_[$i - 1];
649 $max = $_[$i] if $max < $_[$i];
650 }
651 else
652 {
653 $min = $_[$i] if $min > $_[$i];
654 $max = $_[$i - 1] if $max < $_[$i - 1];
655 }
656 }
657
658 if (@_ & 1)
659 {
660 my $i = $#_;
661 if ($_[$i - 1] <= $_[$i])
662 {
663 $min = $_[$i - 1] if $min > $_[$i - 1];
664 $max = $_[$i] if $max < $_[$i];
665 }
666 else
667 {
668 $min = $_[$i] if $min > $_[$i];
669 $max = $_[$i - 1] if $max < $_[$i - 1];
670 }
671 }
672
673 return ($min, $max);
674}
675
676sub minmaxstr (@)
677{
678 return unless @_;
679 my $min = my $max = $_[0];
680
681 for (my $i = 1; $i < @_; $i += 2)
682 {
683 if ($_[$i - 1] le $_[$i])
684 {
685 $min = $_[$i - 1] if $min gt $_[$i - 1];
686 $max = $_[$i] if $max lt $_[$i];
687 }
688 else
689 {
690 $min = $_[$i] if $min gt $_[$i];
691 $max = $_[$i - 1] if $max lt $_[$i - 1];
692 }
693 }
694
695 if (@_ & 1)
696 {
697 my $i = $#_;
698 if ($_[$i - 1] le $_[$i])
699 {
700 $min = $_[$i - 1] if $min gt $_[$i - 1];
701 $max = $_[$i] if $max lt $_[$i];
702 }
703 else
704 {
705 $min = $_[$i] if $min gt $_[$i];
706 $max = $_[$i - 1] if $max lt $_[$i - 1];
707 }
708 }
709
710 return ($min, $max);
711}
712
713sub part (&@)
714{
715 my ($code, @list) = @_;
716 my @parts;
717 push @{$parts[$code->($_)]}, $_ foreach @list;
718 return @parts;
719}
720
721sub bsearch(&@)
722{
723 my $code = shift;
724
725 my $rc;
726 my $i = 0;
727 my $j = @_;
728 ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
729 do
730 {
731 my $k = int(($i + $j) / 2);
732
733 $k >= @_ and return;
734
735 local *_ = \$_[$k];
736 $rc = $code->();
737
738 $rc == 0
739 and return wantarray ? $_ : 1;
740
741 if ($rc < 0)
742 {
743 $i = $k + 1;
744 }
745 else
746 {
747 $j = $k - 1;
748 }
749 } until $i > $j;
750
751 return;
752}
753
754sub bsearchidx(&@)
755{
756 my $code = shift;
757
758 my $rc;
759 my $i = 0;
760 my $j = @_;
761 ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
762 do
763 {
764 my $k = int(($i + $j) / 2);
765
766 $k >= @_ and return -1;
767
768 local *_ = \$_[$k];
769 $rc = $code->();
770
771 $rc == 0 and return $k;
772
773 if ($rc < 0)
774 {
775 $i = $k + 1;
776 }
777 else
778 {
779 $j = $k - 1;
780 }
781 } until $i > $j;
782
783 return -1;
784}
785
786sub lower_bound(&@)
787{
788 my $code = shift;
789 my $count = @_;
790 my $first = 0;
791 while ($count > 0)
792 {
793 my $step = $count >> 1;
794 my $it = $first + $step;
795 local *_ = \$_[$it];
796 if ($code->() < 0)
797 {
798 $first = ++$it;
799 $count -= $step + 1;
800 }
801 else
802 {
803 $count = $step;
804 }
805 }
806
807 return $first;
808}
809
810sub upper_bound(&@)
811{
812 my $code = shift;
813 my $count = @_;
814 my $first = 0;
815 while ($count > 0)
816 {
817 my $step = $count >> 1;
818 my $it = $first + $step;
819 local *_ = \$_[$it];
820 if ($code->() <= 0)
821 {
822 $first = ++$it;
823 $count -= $step + 1;
824 }
825 else
826 {
827 $count = $step;
828 }
829 }
830
831 return $first;
832}
833
834sub equal_range(&@)
835{
836 my $lb = &lower_bound(@_);
837 my $ub = &upper_bound(@_);
838 return ($lb, $ub);
839}
840
841sub binsert (&$\@)
842{
843 my $lb = &lower_bound($_[0], @{$_[2]});
844 splice @{$_[2]}, $lb, 0, $_[1];
845 return $lb;
846}
847
848sub bremove (&\@)
849{
850 my $lb = &lower_bound($_[0], @{$_[1]});
851 return splice @{$_[1]}, $lb, 1;
852}
853
854sub qsort(&\@)
855{
856 require Carp;
857 Carp::croak("It's insane to use a pure-perl qsort");
858}
859
860sub slide(&@)
861{
862 my $op = shift;
863 my @l = @_;
864
865 ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
866 # Localise $a, $b
867 my ($caller_a, $caller_b) = do
868 {
869 my $pkg = caller();
8702471µs243µs
# spent 30µs (17+13) within List::MoreUtils::PP::BEGIN@870 which was called: # once (17µs+13µs) by List::MoreUtils::BEGIN@21 at line 870
no strict 'refs';
# spent 30µs making 1 call to List::MoreUtils::PP::BEGIN@870 # spent 13µs making 1 call to strict::unimport
871 \*{$pkg . '::a'}, \*{$pkg . '::b'};
872 };
873
874 ## no critic (Variables::RequireInitializationForLocalVars)
875 # This map expression is also the return value
876 local (*$caller_a, *$caller_b);
877 ## no critic (BuiltinFunctions::ProhibitComplexMappings)
878 return map {
879 # Assign to $a, $b as refs to caller's array elements
880 (*$caller_a, *$caller_b) = \($l[$_], $l[$_ + 1]);
881
882 # Perform the transformation
883 $op->();
884 } 0 .. ($#l - 1);
885}
886
887sub slideatatime ($$@)
888{
889 my ($m, $w, @list) = @_;
890 my $n = $w - $m - 1;
891 return $n >= 0
892 ? sub { my @r = splice @list, 0, $m; $#list < $n and $n = $#list; @r and push @r, (@list ? @list[0 .. $n] : ()); return @r; }
893 : sub { return splice @list, 0, $m; };
894}
895
896sub sort_by(&@)
897{
898 my ($code, @list) = @_;
899 return map { $_->[0] }
900 sort { $a->[1] cmp $b->[1] }
901 map { [$_, scalar($code->())] } @list;
902}
903
904sub nsort_by(&@)
905{
906 my ($code, @list) = @_;
907 return map { $_->[0] }
908 sort { $a->[1] <=> $b->[1] }
909 map { [$_, scalar($code->())] } @list;
910}
911
912## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
913sub _XScompiled { return 0 }
914
915=head1 SEE ALSO
916
917L<List::Util>
918
919=head1 AUTHOR
920
921Jens Rehsack E<lt>rehsack AT cpan.orgE<gt>
922
923Adam Kennedy E<lt>adamk@cpan.orgE<gt>
924
925Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
926
927=head1 COPYRIGHT AND LICENSE
928
929Some parts copyright 2011 Aaron Crane.
930
931Copyright 2004 - 2010 by Tassilo von Parseval
932
933Copyright 2013 - 2017 by Jens Rehsack
934
935All code added with 0.417 or later is licensed under the Apache License,
936Version 2.0 (the "License"); you may not use this file except in compliance
937with the License. You may obtain a copy of the License at
938
939 http://www.apache.org/licenses/LICENSE-2.0
940
941Unless required by applicable law or agreed to in writing, software
942distributed under the License is distributed on an "AS IS" BASIS,
943WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
944See the License for the specific language governing permissions and
945limitations under the License.
946
947All code until 0.416 is licensed under the same terms as Perl itself,
948either Perl version 5.8.4 or, at your option, any later version of
949Perl 5 you may have available.
950
951=cut
952
95316µs1;
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.