cpan/Scalar-List-Utils/lib/List/Util.pm

   1 # Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
   2 # This program is free software; you can redistribute it and/or
   3 # modify it under the same terms as Perl itself.
   4 #
   5 # Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
   6
   7 package List::Util;
   8
   9 use strict;
  10 use warnings;
  11 require Exporter;
  12
  13 our @ISA        = qw(Exporter);
  14 our @EXPORT_OK  = qw(
  15   all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr
  16   pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
  17 );
  18 our $VERSION    = "1.46";
  19 our $XS_VERSION = $VERSION;
  20 $VERSION    = eval $VERSION;
  21
  22 require XSLoader;
  23 XSLoader::load('List::Util', $XS_VERSION);
  24
  25 sub import
  26 {
  27   my $pkg = caller;
  28
  29   # (RT88848) Touch the caller's $a and $b, to avoid the warning of
  30   #   Name "main::a" used only once: possible typo" warning
  31   no strict 'refs';
  32   ${"${pkg}::a"} = ${"${pkg}::a"};
  33   ${"${pkg}::b"} = ${"${pkg}::b"};
  34
  35   goto &Exporter::import;
  36 }
  37
  38 # For objects returned by pairs()
  39 sub List::Util::_Pair::key   { shift->[0] }
  40 sub List::Util::_Pair::value { shift->[1] }
  41
  42 =head1 NAME
  43
  44 List::Util - A selection of general-utility list subroutines
  45
  46 =head1 SYNOPSIS
  47
  48     use List::Util qw(
  49       reduce any all none notall first
  50
  51       max maxstr min minstr product sum sum0
  52
  53       pairs unpairs pairkeys pairvalues pairfirst pairgrep pairmap
  54
  55       shuffle uniq uniqnum uniqstr
  56     );
  57
  58 =head1 DESCRIPTION
  59
  60 C<List::Util> contains a selection of subroutines that people have expressed
  61 would be nice to have in the perl core, but the usage would not really be high
  62 enough to warrant the use of a keyword, and the size so small such that being
  63 individual extensions would be wasteful.
  64
  65 By default C<List::Util> does not export any subroutines.
  66
  67 =cut
  68
  69 =head1 LIST-REDUCTION FUNCTIONS
  70
  71 The following set of functions all reduce a list down to a single value.
  72
  73 =cut
  74
  75 =head2 reduce
  76
  77     $result = reduce { BLOCK } @list
  78
  79 Reduces C<@list> by calling C<BLOCK> in a scalar context multiple times,
  80 setting C<$a> and C<$b> each time. The first call will be with C<$a> and C<$b>
  81 set to the first two elements of the list, subsequent calls will be done by
  82 setting C<$a> to the result of the previous call and C<$b> to the next element
  83 in the list.
  84
  85 Returns the result of the last call to the C<BLOCK>. If C<@list> is empty then
  86 C<undef> is returned. If C<@list> only contains one element then that element
  87 is returned and C<BLOCK> is not executed.
  88
  89 The following examples all demonstrate how C<reduce> could be used to implement
  90 the other list-reduction functions in this module. (They are not in fact
  91 implemented like this, but instead in a more efficient manner in individual C
  92 functions).
  93
  94     $foo = reduce { defined($a)            ? $a :
  95                     $code->(local $_ = $b) ? $b :
  96                                              undef } undef, @list # first
  97
  98     $foo = reduce { $a > $b ? $a : $b } 1..10       # max
  99     $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'   # maxstr
 100     $foo = reduce { $a < $b ? $a : $b } 1..10       # min
 101     $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
 102     $foo = reduce { $a + $b } 1 .. 10               # sum
 103     $foo = reduce { $a . $b } @bar                  # concat
 104
 105     $foo = reduce { $a || $code->(local $_ = $b) } 0, @bar   # any
 106     $foo = reduce { $a && $code->(local $_ = $b) } 1, @bar   # all
 107     $foo = reduce { $a && !$code->(local $_ = $b) } 1, @bar  # none
 108     $foo = reduce { $a || !$code->(local $_ = $b) } 0, @bar  # notall
 109        # Note that these implementations do not fully short-circuit
 110
 111 If your algorithm requires that C<reduce> produce an identity value, then make
 112 sure that you always pass that identity value as the first argument to prevent
 113 C<undef> being returned
 114
 115   $foo = reduce { $a + $b } 0, @values;             # sum with 0 identity value
 116
 117 The above example code blocks also suggest how to use C<reduce> to build a
 118 more efficient combined version of one of these basic functions and a C<map>
 119 block. For example, to find the total length of the all the strings in a list,
 120 we could use
 121
 122     $total = sum map { length } @strings;
 123
 124 However, this produces a list of temporary integer values as long as the
 125 original list of strings, only to reduce it down to a single value again. We
 126 can compute the same result more efficiently by using C<reduce> with a code
 127 block that accumulates lengths by writing this instead as:
 128
 129     $total = reduce { $a + length $b } 0, @strings
 130
 131 The remaining list-reduction functions are all specialisations of this generic
 132 idea.
 133
 134 =head2 any
 135
 136     my $bool = any { BLOCK } @list;
 137
 138 I<Since version 1.33.>
 139
 140 Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
 141 of C<@list> in turn. C<any> returns true if any element makes the C<BLOCK>
 142 return a true value. If C<BLOCK> never returns true or C<@list> was empty then
 143 it returns false.
 144
 145 Many cases of using C<grep> in a conditional can be written using C<any>
 146 instead, as it can short-circuit after the first true result.
 147
 148     if( any { length > 10 } @strings ) {
 149         # at least one string has more than 10 characters
 150     }
 151
 152 =head2 all
 153
 154     my $bool = all { BLOCK } @list;
 155
 156 I<Since version 1.33.>
 157
 158 Similar to L</any>, except that it requires all elements of the C<@list> to
 159 make the C<BLOCK> return true. If any element returns false, then it returns
 160 false. If the C<BLOCK> never returns false or the C<@list> was empty then it
 161 returns true.
 162
 163 =head2 none
 164
 165 =head2 notall
 166
 167     my $bool = none { BLOCK } @list;
 168
 169     my $bool = notall { BLOCK } @list;
 170
 171 I<Since version 1.33.>
 172
 173 Similar to L</any> and L</all>, but with the return sense inverted. C<none>
 174 returns true only if no value in the C<@list> causes the C<BLOCK> to return
 175 true, and C<notall> returns true only if not all of the values do.
 176
 177 =head2 first
 178
 179     my $val = first { BLOCK } @list;
 180
 181 Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
 182 of C<@list> in turn. C<first> returns the first element where the result from
 183 C<BLOCK> is a true value. If C<BLOCK> never returns true or C<@list> was empty
 184 then C<undef> is returned.
 185
 186     $foo = first { defined($_) } @list    # first defined value in @list
 187     $foo = first { $_ > $value } @list    # first value in @list which
 188                                           # is greater than $value
 189
 190 =head2 max
 191
 192     my $num = max @list;
 193
 194 Returns the entry in the list with the highest numerical value. If the list is
 195 empty then C<undef> is returned.
 196
 197     $foo = max 1..10                # 10
 198     $foo = max 3,9,12               # 12
 199     $foo = max @bar, @baz           # whatever
 200
 201 =head2 maxstr
 202
 203     my $str = maxstr @list;
 204
 205 Similar to L</max>, but treats all the entries in the list as strings and
 206 returns the highest string as defined by the C<gt> operator. If the list is
 207 empty then C<undef> is returned.
 208
 209     $foo = maxstr 'A'..'Z'          # 'Z'
 210     $foo = maxstr "hello","world"   # "world"
 211     $foo = maxstr @bar, @baz        # whatever
 212
 213 =head2 min
 214
 215     my $num = min @list;
 216
 217 Similar to L</max> but returns the entry in the list with the lowest numerical
 218 value. If the list is empty then C<undef> is returned.
 219
 220     $foo = min 1..10                # 1
 221     $foo = min 3,9,12               # 3
 222     $foo = min @bar, @baz           # whatever
 223
 224 =head2 minstr
 225
 226     my $str = minstr @list;
 227
 228 Similar to L</min>, but treats all the entries in the list as strings and
 229 returns the lowest string as defined by the C<lt> operator. If the list is
 230 empty then C<undef> is returned.
 231
 232     $foo = minstr 'A'..'Z'          # 'A'
 233     $foo = minstr "hello","world"   # "hello"
 234     $foo = minstr @bar, @baz        # whatever
 235
 236 =head2 product
 237
 238     my $num = product @list;
 239
 240 I<Since version 1.35.>
 241
 242 Returns the numerical product of all the elements in C<@list>. If C<@list> is
 243 empty then C<1> is returned.
 244
 245     $foo = product 1..10            # 3628800
 246     $foo = product 3,9,12           # 324
 247
 248 =head2 sum
 249
 250     my $num_or_undef = sum @list;
 251
 252 Returns the numerical sum of all the elements in C<@list>. For backwards
 253 compatibility, if C<@list> is empty then C<undef> is returned.
 254
 255     $foo = sum 1..10                # 55
 256     $foo = sum 3,9,12               # 24
 257     $foo = sum @bar, @baz           # whatever
 258
 259 =head2 sum0
 260
 261     my $num = sum0 @list;
 262
 263 I<Since version 1.26.>
 264
 265 Similar to L</sum>, except this returns 0 when given an empty list, rather
 266 than C<undef>.
 267
 268 =cut
 269
 270 =head1 KEY/VALUE PAIR LIST FUNCTIONS
 271
 272 The following set of functions, all inspired by L<List::Pairwise>, consume an
 273 even-sized list of pairs. The pairs may be key/value associations from a hash,
 274 or just a list of values. The functions will all preserve the original ordering
 275 of the pairs, and will not be confused by multiple pairs having the same "key"
 276 value - nor even do they require that the first of each pair be a plain string.
 277
 278 B<NOTE>: At the time of writing, the following C<pair*> functions that take a
 279 block do not modify the value of C<$_> within the block, and instead operate
 280 using the C<$a> and C<$b> globals instead. This has turned out to be a poor
 281 design, as it precludes the ability to provide a C<pairsort> function. Better
 282 would be to pass pair-like objects as 2-element array references in C<$_>, in
 283 a style similar to the return value of the C<pairs> function. At some future
 284 version this behaviour may be added.
 285
 286 Until then, users are alerted B<NOT> to rely on the value of C<$_> remaining
 287 unmodified between the outside and the inside of the control block. In
 288 particular, the following example is B<UNSAFE>:
 289
 290  my @kvlist = ...
 291
 292  foreach (qw( some keys here )) {
 293     my @items = pairgrep { $a eq $_ } @kvlist;
 294     ...
 295  }
 296
 297 Instead, write this using a lexical variable:
 298
 299  foreach my $key (qw( some keys here )) {
 300     my @items = pairgrep { $a eq $key } @kvlist;
 301     ...
 302  }
 303
 304 =cut
 305
 306 =head2 pairs
 307
 308     my @pairs = pairs @kvlist;
 309
 310 I<Since version 1.29.>
 311
 312 A convenient shortcut to operating on even-sized lists of pairs, this function
 313 returns a list of C<ARRAY> references, each containing two items from the
 314 given list. It is a more efficient version of
 315
 316     @pairs = pairmap { [ $a, $b ] } @kvlist
 317
 318 It is most convenient to use in a C<foreach> loop, for example:
 319
 320     foreach my $pair ( pairs @kvlist ) {
 321        my ( $key, $value ) = @$pair;
 322        ...
 323     }
 324
 325 Since version C<1.39> these C<ARRAY> references are blessed objects,
 326 recognising the two methods C<key> and C<value>. The following code is
 327 equivalent:
 328
 329     foreach my $pair ( pairs @kvlist ) {
 330        my $key   = $pair->key;
 331        my $value = $pair->value;
 332        ...
 333     }
 334
 335 =head2 unpairs
 336
 337     my @kvlist = unpairs @pairs
 338
 339 I<Since version 1.42.>
 340
 341 The inverse function to C<pairs>; this function takes a list of C<ARRAY>
 342 references containing two elements each, and returns a flattened list of the
 343 two values from each of the pairs, in order. This is notionally equivalent to
 344
 345     my @kvlist = map { @{$_}[0,1] } @pairs
 346
 347 except that it is implemented more efficiently internally. Specifically, for
 348 any input item it will extract exactly two values for the output list; using
 349 C<undef> if the input array references are short.
 350
 351 Between C<pairs> and C<unpairs>, a higher-order list function can be used to
 352 operate on the pairs as single scalars; such as the following near-equivalents
 353 of the other C<pair*> higher-order functions:
 354
 355     @kvlist = unpairs grep { FUNC } pairs @kvlist
 356     # Like pairgrep, but takes $_ instead of $a and $b
 357
 358     @kvlist = unpairs map { FUNC } pairs @kvlist
 359     # Like pairmap, but takes $_ instead of $a and $b
 360
 361 Note however that these versions will not behave as nicely in scalar context.
 362
 363 Finally, this technique can be used to implement a sort on a keyvalue pair
 364 list; e.g.:
 365
 366     @kvlist = unpairs sort { $a->key cmp $b->key } pairs @kvlist
 367
 368 =head2 pairkeys
 369
 370     my @keys = pairkeys @kvlist;
 371
 372 I<Since version 1.29.>
 373
 374 A convenient shortcut to operating on even-sized lists of pairs, this function
 375 returns a list of the the first values of each of the pairs in the given list.
 376 It is a more efficient version of
 377
 378     @keys = pairmap { $a } @kvlist
 379
 380 =head2 pairvalues
 381
 382     my @values = pairvalues @kvlist;
 383
 384 I<Since version 1.29.>
 385
 386 A convenient shortcut to operating on even-sized lists of pairs, this function
 387 returns a list of the the second values of each of the pairs in the given list.
 388 It is a more efficient version of
 389
 390     @values = pairmap { $b } @kvlist
 391
 392 =head2 pairgrep
 393
 394     my @kvlist = pairgrep { BLOCK } @kvlist;
 395
 396     my $count = pairgrep { BLOCK } @kvlist;
 397
 398 I<Since version 1.29.>
 399
 400 Similar to perl's C<grep> keyword, but interprets the given list as an
 401 even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
 402 context, with C<$a> and C<$b> set to successive pairs of values from the
 403 C<@kvlist>.
 404
 405 Returns an even-sized list of those pairs for which the C<BLOCK> returned true
 406 in list context, or the count of the B<number of pairs> in scalar context.
 407 (Note, therefore, in scalar context that it returns a number half the size of
 408 the count of items it would have returned in list context).
 409
 410     @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
 411
 412 As with C<grep> aliasing C<$_> to list elements, C<pairgrep> aliases C<$a> and
 413 C<$b> to elements of the given list. Any modifications of it by the code block
 414 will be visible to the caller.
 415
 416 =head2 pairfirst
 417
 418     my ( $key, $val ) = pairfirst { BLOCK } @kvlist;
 419
 420     my $found = pairfirst { BLOCK } @kvlist;
 421
 422 I<Since version 1.30.>
 423
 424 Similar to the L</first> function, but interprets the given list as an
 425 even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
 426 context, with C<$a> and C<$b> set to successive pairs of values from the
 427 C<@kvlist>.
 428
 429 Returns the first pair of values from the list for which the C<BLOCK> returned
 430 true in list context, or an empty list of no such pair was found. In scalar
 431 context it returns a simple boolean value, rather than either the key or the
 432 value found.
 433
 434     ( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist
 435
 436 As with C<grep> aliasing C<$_> to list elements, C<pairfirst> aliases C<$a> and
 437 C<$b> to elements of the given list. Any modifications of it by the code block
 438 will be visible to the caller.
 439
 440 =head2 pairmap
 441
 442     my @list = pairmap { BLOCK } @kvlist;
 443
 444     my $count = pairmap { BLOCK } @kvlist;
 445
 446 I<Since version 1.29.>
 447
 448 Similar to perl's C<map> keyword, but interprets the given list as an
 449 even-sized list of pairs. It invokes the C<BLOCK> multiple times, in list
 450 context, with C<$a> and C<$b> set to successive pairs of values from the
 451 C<@kvlist>.
 452
 453 Returns the concatenation of all the values returned by the C<BLOCK> in list
 454 context, or the count of the number of items that would have been returned in
 455 scalar context.
 456
 457     @result = pairmap { "The key $a has value $b" } @kvlist
 458
 459 As with C<map> aliasing C<$_> to list elements, C<pairmap> aliases C<$a> and
 460 C<$b> to elements of the given list. Any modifications of it by the code block
 461 will be visible to the caller.
 462
 463 See L</KNOWN BUGS> for a known-bug with C<pairmap>, and a workaround.
 464
 465 =cut
 466
 467 =head1 OTHER FUNCTIONS
 468
 469 =cut
 470
 471 =head2 shuffle
 472
 473     my @values = shuffle @values;
 474
 475 Returns the values of the input in a random order
 476
 477     @cards = shuffle 0..51      # 0..51 in a random order
 478
 479 =head2 uniq
 480
 481     my @subset = uniq @values
 482
 483 I<Since version 1.45.>
 484
 485 Filters a list of values to remove subsequent duplicates, as judged by a
 486 DWIM-ish string equality or C<undef> test. Preserves the order of unique
 487 elements, and retains the first value of any duplicate set.
 488
 489     my $count = uniq @values
 490
 491 In scalar context, returns the number of elements that would have been
 492 returned as a list.
 493
 494 The C<undef> value is treated by this function as distinct from the empty
 495 string, and no warning will be produced. It is left as-is in the returned
 496 list. Subsequent C<undef> values are still considered identical to the first,
 497 and will be removed.
 498
 499 =head2 uniqnum
 500
 501     my @subset = uniqnum @values
 502
 503 I<Since version 1.44.>
 504
 505 Filters a list of values to remove subsequent duplicates, as judged by a
 506 numerical equality test. Preserves the order of unique elements, and retains
 507 the first value of any duplicate set.
 508
 509     my $count = uniqnum @values
 510
 511 In scalar context, returns the number of elements that would have been
 512 returned as a list.
 513
 514 Note that C<undef> is treated much as other numerical operations treat it; it
 515 compares equal to zero but additionally produces a warning if such warnings
 516 are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
 517 the returned list is coerced into a numerical zero, so that the entire list of
 518 values returned by C<uniqnum> are well-behaved as numbers.
 519
 520 Note also that multiple IEEE C<NaN> values are treated as duplicates of
 521 each other, regardless of any differences in their payloads, and despite
 522 the fact that C<< 0+'NaN' == 0+'NaN' >> yields false.
 523
 524 =head2 uniqstr
 525
 526     my @subset = uniqstr @values
 527
 528 I<Since version 1.45.>
 529
 530 Filters a list of values to remove subsequent duplicates, as judged by a
 531 string equality test. Preserves the order of unique elements, and retains the
 532 first value of any duplicate set.
 533
 534     my $count = uniqstr @values
 535
 536 In scalar context, returns the number of elements that would have been
 537 returned as a list.
 538
 539 Note that C<undef> is treated much as other string operations treat it; it
 540 compares equal to the empty string but additionally produces a warning if such
 541 warnings are enabled (C<use warnings 'uninitialized';>). In addition, an
 542 C<undef> in the returned list is coerced into an empty string, so that the
 543 entire list of values returned by C<uniqstr> are well-behaved as strings.
 544
 545 =cut
 546
 547 =head1 KNOWN BUGS
 548
 549 =head2 RT #95409
 550
 551 L<https://rt.cpan.org/Ticket/Display.html?id=95409>
 552
 553 If the block of code given to L</pairmap> contains lexical variables that are
 554 captured by a returned closure, and the closure is executed after the block
 555 has been re-used for the next iteration, these lexicals will not see the
 556 correct values. For example:
 557
 558  my @subs = pairmap {
 559     my $var = "$a is $b";
 560     sub { print "$var\n" };
 561  } one => 1, two => 2, three => 3;
 562
 563  $_->() for @subs;
 564
 565 Will incorrectly print
 566
 567  three is 3
 568  three is 3
 569  three is 3
 570
 571 This is due to the performance optimisation of using C<MULTICALL> for the code
 572 block, which means that fresh SVs do not get allocated for each call to the
 573 block. Instead, the same SV is re-assigned for each iteration, and all the
 574 closures will share the value seen on the final iteration.
 575
 576 To work around this bug, surround the code with a second set of braces. This
 577 creates an inner block that defeats the C<MULTICALL> logic, and does get fresh
 578 SVs allocated each time:
 579
 580  my @subs = pairmap {
 581     {
 582        my $var = "$a is $b";
 583        sub { print "$var\n"; }
 584     }
 585  } one => 1, two => 2, three => 3;
 586
 587 This bug only affects closures that are generated by the block but used
 588 afterwards. Lexical variables that are only used during the lifetime of the
 589 block's execution will take their individual values for each invocation, as
 590 normal.
 591
 592 =head2 uniqnum() on oversized bignums
 593
 594 Due to the way that C<uniqnum()> compares numbers, it cannot distinguish
 595 differences between bignums (especially bigints) that are too large to fit in
 596 the native platform types. For example,
 597
 598  my $x = Math::BigInt->new( "1" x 100 );
 599  my $y = $x + 1;
 600
 601  say for uniqnum( $x, $y );
 602
 603 Will print just the value of C<$x>, believing that C<$y> is a numerically-
 604 equivalent value. This bug does not affect C<uniqstr()>, which will correctly
 605 observe that the two values stringify to different strings.
 606
 607 =head1 SUGGESTED ADDITIONS
 608
 609 The following are additions that have been requested, but I have been reluctant
 610 to add due to them being very simple to implement in perl
 611
 612   # How many elements are true
 613
 614   sub true { scalar grep { $_ } @_ }
 615
 616   # How many elements are false
 617
 618   sub false { scalar grep { !$_ } @_ }
 619
 620 =head1 SEE ALSO
 621
 622 L<Scalar::Util>, L<List::MoreUtils>
 623
 624 =head1 COPYRIGHT
 625
 626 Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
 627 This program is free software; you can redistribute it and/or
 628 modify it under the same terms as Perl itself.
 629
 630 Recent additions and current maintenance by
 631 Paul Evans, <leonerd@leonerd.org.uk>.
 632
 633 =cut
 634
 635 1;