List-UtilsBy-0.11000755001750001750 013234447567 12477 5ustar00leoleo000000000000List-UtilsBy-0.11/Build.PL000444001750001750 72113234447567 14110 0ustar00leoleo000000000000use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'List::UtilsBy', requires => { 'Exporter' => '5.57', }, test_requires => { 'Test::More' => '0.88', # done_testing }, configure_requires => { 'Module::Build' => '0.4004', # test_requires }, license => 'perl', create_makefile_pl => 'traditional', create_license => 1, create_readme => 1, ); $build->create_build_script; List-UtilsBy-0.11/Changes000444001750001750 272013234447567 14130 0ustar00leoleo000000000000Revision history for List-UtilsBy 0.11 2018-01-31 23:12:44 [CHANGES] * Added 'minmax_by' (RT124275) [BUGFIXES] * use lib '.' for 5.26+ (RT120418) 0.10 2015/07/16 19:22:00 [CHANGES] * Added 'extract_first_by' * Updated documentation: + Added 'since' version to all functions + Use =head2 barename for nicer indexing 0.09 CHANGES: * Added 'unzip_by' * Added 'nmax_by' and 'nmin_by' name aliases for 'max_by'/'min_by' 0.08 CHANGES: * Ensure that 'bundle_by' passes a short list to the body function rather than trailing undefs * Better hopefully-more efficient implementation of *sort_by. * Removed back-compat renames of sortby etc.. 0.07 CHANGES: * Added 'count_by', 'weighted_shuffle_by', 'bundle_by' 0.06 CHANGES: * Added 'rev_sort_by' and 'rev_nsort_by' * Allow 'max_by' and 'min_by' in list context to return all optimal * Test and document that 'extract_by' does not break weak references 0.05 CHANGES: * Added 'extract_by' 0.04 CHANGES: * Renamed functions sortby => sort_by, etc... Including back-compat aliases by the old names 0.03 CHANGES: * Added 'zipby' 0.02 CHANGES: * Added 'partitionby' * import Exporter::import rather than use base'ing it 0.01 First version, released on an unsuspecting world. List-UtilsBy-0.11/LICENSE000444001750001750 4376213234447567 13675 0ustar00leoleo000000000000This software is copyright (c) 2018 by Paul Evans . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2018 by Paul Evans . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2018 by Paul Evans . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End List-UtilsBy-0.11/MANIFEST000444001750001750 51013234447567 13741 0ustar00leoleo000000000000Build.PL Changes lib/List/UtilsBy.pm LICENSE Makefile.PL MANIFEST This list of files META.json META.yml README t/00use.t t/01sort_by.t t/02nsort_by.t t/03max_min_by.t t/05uniq_by.t t/06partition_by.t t/07count_by.t t/08zip_by.t t/09unzip_by.t t/10extract_by.t t/11weighted_shuffle_by.t t/12bundle_by.t t/99pod.t t/Unrandom.pm List-UtilsBy-0.11/META.json000444001750001750 200213234447567 14247 0ustar00leoleo000000000000{ "abstract" : "higher-order list utility functions", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.422", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "List-UtilsBy", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.4004" } }, "runtime" : { "requires" : { "Exporter" : "5.57" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "provides" : { "List::UtilsBy" : { "file" : "lib/List/UtilsBy.pm", "version" : "0.11" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.11", "x_serialization_backend" : "JSON::PP version 2.94" } List-UtilsBy-0.11/META.yml000444001750001750 120313234447567 14101 0ustar00leoleo000000000000--- abstract: 'higher-order list utility functions' author: - 'Paul Evans ' build_requires: Test::More: '0.88' configure_requires: Module::Build: '0.4004' dynamic_config: 1 generated_by: 'Module::Build version 0.422, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: List-UtilsBy provides: List::UtilsBy: file: lib/List/UtilsBy.pm version: '0.11' requires: Exporter: '5.57' resources: license: http://dev.perl.org/licenses/ version: '0.11' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' List-UtilsBy-0.11/Makefile.PL000444001750001750 52413234447567 14567 0ustar00leoleo000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4220 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'List::UtilsBy', 'VERSION_FROM' => 'lib/List/UtilsBy.pm', 'PREREQ_PM' => { 'Exporter' => '5.57' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; List-UtilsBy-0.11/README000444001750001750 3044013234447567 13535 0ustar00leoleo000000000000NAME List::UtilsBy - higher-order list utility functions SYNOPSIS use List::UtilsBy qw( nsort_by min_by ); use File::stat qw( stat ); my @files_by_age = nsort_by { stat($_)->mtime } @files; my $shortest_name = min_by { length } @names; DESCRIPTION This module provides a number of list utility functions, all of which take an initial code block to control their behaviour. They are variations on similar core perl or List::Util functions of similar names, but which use the block to control their behaviour. For example, the core Perl function sort takes a list of values and returns them, sorted into order by their string value. The "sort_by" function sorts them according to the string value returned by the extra function, when given each value. my @names_sorted = sort @names; my @people_sorted = sort_by { $_->name } @people; FUNCTIONS All functions added since version 0.04 unless otherwise stated, as the original names for earlier versions were renamed. sort_by @vals = sort_by { KEYFUNC } @vals Returns the list of values sorted according to the string values returned by the KEYFUNC block or function. A typical use of this may be to sort objects according to the string value of some accessor, such as sort_by { $_->name } @people The key function is called in scalar context, being passed each value in turn as both $_ and the only argument in the parameters, @_. The values are then sorted according to string comparisons on the values returned. This is equivalent to sort { $a->name cmp $b->name } @people except that it guarantees the name accessor will be executed only once per value. One interesting use-case is to sort strings which may have numbers embedded in them "naturally", rather than lexically. sort_by { s/(\d+)/sprintf "%09d", $1/eg; $_ } @strings This sorts strings by generating sort keys which zero-pad the embedded numbers to some level (9 digits in this case), helping to ensure the lexical sort puts them in the correct order. nsort_by @vals = nsort_by { KEYFUNC } @vals Similar to "sort_by" but compares its key values numerically. rev_sort_by rev_nsort_by @vals = rev_sort_by { KEYFUNC } @vals @vals = rev_nsort_by { KEYFUNC } @vals Since version 0.06. Similar to "sort_by" and "nsort_by" but returns the list in the reverse order. Equivalent to @vals = reverse sort_by { KEYFUNC } @vals except that these functions are slightly more efficient because they avoid the final reverse operation. max_by $optimal = max_by { KEYFUNC } @vals @optimal = max_by { KEYFUNC } @vals Returns the (first) value from @vals that gives the numerically largest result from the key function. my $tallest = max_by { $_->height } @people use File::stat qw( stat ); my $newest = max_by { stat($_)->mtime } @files; In scalar context, the first maximal value is returned. In list context, a list of all the maximal values is returned. This may be used to obtain positions other than the first, if order is significant. If called on an empty list, an empty list is returned. For symmetry with the "nsort_by" function, this is also provided under the name nmax_by since it behaves numerically. min_by $optimal = min_by { KEYFUNC } @vals @optimal = min_by { KEYFUNC } @vals Similar to "max_by" but returns values which give the numerically smallest result from the key function. Also provided as nmin_by minmax_by ( $minimal, $maximal ) = minmax_by { KEYFUNC } @vals Since version 0.11. Similar to calling both "min_by" and "max_by" with the same key function on the same list. This version is more efficient than calling the two other functions individually, as it has less work to perform overall. In the case of ties, only the first optimal element found in each case is returned. Also provided as nminmax_by. uniq_by @vals = uniq_by { KEYFUNC } @vals Returns a list of the subset of values for which the key function block returns unique values. The first value yielding a particular key is chosen, subsequent values are rejected. my @some_fruit = uniq_by { $_->colour } @fruit; To select instead the last value per key, reverse the input list. If the order of the results is significant, don't forget to reverse the result as well: my @some_fruit = reverse uniq_by { $_->colour } reverse @fruit; Because the values returned by the key function are used as hash keys, they ought to either be strings, or at least well-behaved as strings (such as numbers, or object references which overload stringification in a suitable manner). partition_by %parts = partition_by { KEYFUNC } @vals Returns a key/value list of ARRAY refs containing all the original values distributed according to the result of the key function block. Each value will be an ARRAY ref containing all the values which returned the string from the key function, in their original order. my %balls_by_colour = partition_by { $_->colour } @balls; Because the values returned by the key function are used as hash keys, they ought to either be strings, or at least well-behaved as strings (such as numbers, or object references which overload stringification in a suitable manner). count_by %counts = count_by { KEYFUNC } @vals Since version 0.07. Returns a key/value list of integers, giving the number of times the key function block returned the key, for each value in the list. my %count_of_balls = count_by { $_->colour } @balls; Because the values returned by the key function are used as hash keys, they ought to either be strings, or at least well-behaved as strings (such as numbers, or object references which overload stringification in a suitable manner). zip_by @vals = zip_by { ITEMFUNC } \@arr0, \@arr1, \@arr2,... Returns a list of each of the values returned by the function block, when invoked with values from across each each of the given ARRAY references. Each value in the returned list will be the result of the function having been invoked with arguments at that position, from across each of the arrays given. my @transposition = zip_by { [ @_ ] } @matrix; my @names = zip_by { "$_[1], $_[0]" } \@firstnames, \@surnames; print zip_by { "$_[0] => $_[1]\n" } [ keys %hash ], [ values %hash ]; If some of the arrays are shorter than others, the function will behave as if they had undef in the trailing positions. The following two lines are equivalent: zip_by { f(@_) } [ 1, 2, 3 ], [ "a", "b" ] f( 1, "a" ), f( 2, "b" ), f( 3, undef ) The item function is called by map, so if it returns a list, the entire list is included in the result. This can be useful for example, for generating a hash from two separate lists of keys and values my %nums = zip_by { @_ } [qw( one two three )], [ 1, 2, 3 ]; # %nums = ( one => 1, two => 2, three => 3 ) (A function having this behaviour is sometimes called zipWith, e.g. in Haskell, but that name would not fit the naming scheme used by this module). unzip_by $arr0, $arr1, $arr2, ... = unzip_by { ITEMFUNC } @vals Since version 0.09. Returns a list of ARRAY references containing the values returned by the function block, when invoked for each of the values given in the input list. Each of the returned ARRAY references will contain the values returned at that corresponding position by the function block. That is, the first returned ARRAY reference will contain all the values returned in the first position by the function block, the second will contain all the values from the second position, and so on. my ( $firstnames, $lastnames ) = unzip_by { m/^(.*?) (.*)$/ } @names; If the function returns lists of differing lengths, the result will be padded with undef in the missing elements. This function is an inverse of "zip_by", if given a corresponding inverse function. extract_by @vals = extract_by { SELECTFUNC } @arr Since version 0.05. Removes elements from the referenced array on which the selection function returns true, and returns a list containing those elements. This function is similar to grep, except that it modifies the referenced array to remove the selected values from it, leaving only the unselected ones. my @red_balls = extract_by { $_->color eq "red" } @balls; # Now there are no red balls in the @balls array This function modifies a real array, unlike most of the other functions in this module. Because of this, it requires a real array, not just a list. This function is implemented by invoking splice on the array, not by constructing a new list and assigning it. One result of this is that weak references will not be disturbed. extract_by { !defined $_ } @refs; will leave weak references weakened in the @refs array, whereas @refs = grep { defined $_ } @refs; will strengthen them all again. extract_first_by $val = extract_first_by { SELECTFUNC } @arr Since version 0.10. A hybrid between "extract_by" and List::Util::first. Removes the first element from the referenced array on which the selection function returns true, returning it. As with "extract_by", this function requires a real array and not just a list, and is also implemented using splice so that weak references are not disturbed. If this function fails to find a matching element, it will return an empty list in list context. This allows a caller to distinguish the case between no matching element, and the first matching element being undef. weighted_shuffle_by @vals = weighted_shuffle_by { WEIGHTFUNC } @vals Since version 0.07. Returns the list of values shuffled into a random order. The randomisation is not uniform, but weighted by the value returned by the WEIGHTFUNC. The probabilty of each item being returned first will be distributed with the distribution of the weights, and so on recursively for the remaining items. bundle_by @vals = bundle_by { BLOCKFUNC } $number, @vals Since version 0.07. Similar to a regular map functional, returns a list of the values returned by BLOCKFUNC. Values from the input list are given to the block function in bundles of $number. If given a list of values whose length does not evenly divide by $number, the final call will be passed fewer elements than the others. TODO * XS implementations These functions are currently all written in pure perl. Some at least, may benefit from having XS implementations to speed up their logic. * Merge into List::Util or List::MoreUtils This module shouldn't really exist. The functions should instead be part of one of the existing modules that already contain many list utility functions. Having Yet Another List Utilty Module just worsens the problem. I have attempted to contact the authors of both of the above modules, to no avail; therefore I decided it best to write and release this code here anyway so that it is at least on CPAN. Once there, we can then see how best to merge it into an existing module. Updated 2015/07/16: As I am now the maintainer of List::Util, some amount of merging/copying should be possible. However, given the latter's key position in the core perl distribution and head of the "CPAN River" I am keen not to do this wholesale, but a selected pick of what seems best, by a popular consensus. * head and tail-like functions Consider perhaps head_before { COND } LIST # excludes terminating element head_upto { COND } LIST # includes terminating element tail_since { COND } LIST # includes initiating element tail_after { COND } LIST # excludes initiating element (See also https://rt.cpan.org/Ticket/Display.html?id=105907). AUTHOR Paul Evans List-UtilsBy-0.11/lib000755001750001750 013234447567 13245 5ustar00leoleo000000000000List-UtilsBy-0.11/lib/List000755001750001750 013234447567 14160 5ustar00leoleo000000000000List-UtilsBy-0.11/lib/List/UtilsBy.pm000444001750001750 4231313234447567 16271 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2009-2018 -- leonerd@leonerd.org.uk package List::UtilsBy; use strict; use warnings; our $VERSION = '0.11'; use Exporter 'import'; our @EXPORT_OK = qw( sort_by nsort_by rev_sort_by rev_nsort_by max_by nmax_by min_by nmin_by minmax_by nminmax_by uniq_by partition_by count_by zip_by unzip_by extract_by extract_first_by weighted_shuffle_by bundle_by ); =head1 NAME C - higher-order list utility functions =head1 SYNOPSIS use List::UtilsBy qw( nsort_by min_by ); use File::stat qw( stat ); my @files_by_age = nsort_by { stat($_)->mtime } @files; my $shortest_name = min_by { length } @names; =head1 DESCRIPTION This module provides a number of list utility functions, all of which take an initial code block to control their behaviour. They are variations on similar core perl or C functions of similar names, but which use the block to control their behaviour. For example, the core Perl function C takes a list of values and returns them, sorted into order by their string value. The L function sorts them according to the string value returned by the extra function, when given each value. my @names_sorted = sort @names; my @people_sorted = sort_by { $_->name } @people; =cut =head1 FUNCTIONS All functions added since version 0.04 unless otherwise stated, as the original names for earlier versions were renamed. =cut =head2 sort_by @vals = sort_by { KEYFUNC } @vals Returns the list of values sorted according to the string values returned by the C block or function. A typical use of this may be to sort objects according to the string value of some accessor, such as sort_by { $_->name } @people The key function is called in scalar context, being passed each value in turn as both C<$_> and the only argument in the parameters, C<@_>. The values are then sorted according to string comparisons on the values returned. This is equivalent to sort { $a->name cmp $b->name } @people except that it guarantees the C accessor will be executed only once per value. One interesting use-case is to sort strings which may have numbers embedded in them "naturally", rather than lexically. sort_by { s/(\d+)/sprintf "%09d", $1/eg; $_ } @strings This sorts strings by generating sort keys which zero-pad the embedded numbers to some level (9 digits in this case), helping to ensure the lexical sort puts them in the correct order. =cut sub sort_by(&@) { my $keygen = shift; my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_; return @_[ sort { $keys[$a] cmp $keys[$b] } 0 .. $#_ ]; } =head2 nsort_by @vals = nsort_by { KEYFUNC } @vals Similar to L but compares its key values numerically. =cut sub nsort_by(&@) { my $keygen = shift; my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_; return @_[ sort { $keys[$a] <=> $keys[$b] } 0 .. $#_ ]; } =head2 rev_sort_by =head2 rev_nsort_by @vals = rev_sort_by { KEYFUNC } @vals @vals = rev_nsort_by { KEYFUNC } @vals I Similar to L and L but returns the list in the reverse order. Equivalent to @vals = reverse sort_by { KEYFUNC } @vals except that these functions are slightly more efficient because they avoid the final C operation. =cut sub rev_sort_by(&@) { my $keygen = shift; my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_; return @_[ sort { $keys[$b] cmp $keys[$a] } 0 .. $#_ ]; } sub rev_nsort_by(&@) { my $keygen = shift; my @keys = map { local $_ = $_; scalar $keygen->( $_ ) } @_; return @_[ sort { $keys[$b] <=> $keys[$a] } 0 .. $#_ ]; } =head2 max_by $optimal = max_by { KEYFUNC } @vals @optimal = max_by { KEYFUNC } @vals Returns the (first) value from C<@vals> that gives the numerically largest result from the key function. my $tallest = max_by { $_->height } @people use File::stat qw( stat ); my $newest = max_by { stat($_)->mtime } @files; In scalar context, the first maximal value is returned. In list context, a list of all the maximal values is returned. This may be used to obtain positions other than the first, if order is significant. If called on an empty list, an empty list is returned. For symmetry with the L function, this is also provided under the name C since it behaves numerically. =cut sub max_by(&@) { my $code = shift; return unless @_; local $_; my @maximal = $_ = shift @_; my $max = $code->( $_ ); foreach ( @_ ) { my $this = $code->( $_ ); if( $this > $max ) { @maximal = $_; $max = $this; } elsif( wantarray and $this == $max ) { push @maximal, $_; } } return wantarray ? @maximal : $maximal[0]; } *nmax_by = \&max_by; =head2 min_by $optimal = min_by { KEYFUNC } @vals @optimal = min_by { KEYFUNC } @vals Similar to L but returns values which give the numerically smallest result from the key function. Also provided as C =cut sub min_by(&@) { my $code = shift; return unless @_; local $_; my @minimal = $_ = shift @_; my $min = $code->( $_ ); foreach ( @_ ) { my $this = $code->( $_ ); if( $this < $min ) { @minimal = $_; $min = $this; } elsif( wantarray and $this == $min ) { push @minimal, $_; } } return wantarray ? @minimal : $minimal[0]; } *nmin_by = \&min_by; =head2 minmax_by ( $minimal, $maximal ) = minmax_by { KEYFUNC } @vals I Similar to calling both L and L with the same key function on the same list. This version is more efficient than calling the two other functions individually, as it has less work to perform overall. In the case of ties, only the first optimal element found in each case is returned. Also provided as C. =cut sub minmax_by(&@) { my $code = shift; return unless @_; my $minimal = $_ = shift @_; my $min = $code->( $_ ); return ( $minimal, $minimal ) unless @_; my $maximal = $_ = shift @_; my $max = $code->( $_ ); if( $max < $min ) { ( $maximal, $minimal ) = ( $minimal, $maximal ); ( $max, $min ) = ( $min, $max ); } # Minmax algorithm is faster than naïve min + max individually because it # takes pairs of values while( @_ ) { my $try_minimal = $_ = shift @_; my $try_min = $code->( $_ ); my $try_maximal = $try_minimal; my $try_max = $try_min; if( @_ ) { $try_maximal = $_ = shift @_; $try_max = $code->( $_ ); if( $try_max < $try_min ) { ( $try_minimal, $try_maximal ) = ( $try_maximal, $try_minimal ); ( $try_min, $try_max ) = ( $try_max, $try_min ); } } if( $try_min < $min ) { $minimal = $try_minimal; $min = $try_min; } if( $try_max > $max ) { $maximal = $try_maximal; $max = $try_max; } } return ( $minimal, $maximal ); } *nminmax_by = \&minmax_by; =head2 uniq_by @vals = uniq_by { KEYFUNC } @vals Returns a list of the subset of values for which the key function block returns unique values. The first value yielding a particular key is chosen, subsequent values are rejected. my @some_fruit = uniq_by { $_->colour } @fruit; To select instead the last value per key, reverse the input list. If the order of the results is significant, don't forget to reverse the result as well: my @some_fruit = reverse uniq_by { $_->colour } reverse @fruit; Because the values returned by the key function are used as hash keys, they ought to either be strings, or at least well-behaved as strings (such as numbers, or object references which overload stringification in a suitable manner). =cut sub uniq_by(&@) { my $code = shift; my %present; return grep { my $key = $code->( local $_ = $_ ); !$present{$key}++ } @_; } =head2 partition_by %parts = partition_by { KEYFUNC } @vals Returns a key/value list of ARRAY refs containing all the original values distributed according to the result of the key function block. Each value will be an ARRAY ref containing all the values which returned the string from the key function, in their original order. my %balls_by_colour = partition_by { $_->colour } @balls; Because the values returned by the key function are used as hash keys, they ought to either be strings, or at least well-behaved as strings (such as numbers, or object references which overload stringification in a suitable manner). =cut sub partition_by(&@) { my $code = shift; my %parts; push @{ $parts{ $code->( local $_ = $_ ) } }, $_ for @_; return %parts; } =head2 count_by %counts = count_by { KEYFUNC } @vals I Returns a key/value list of integers, giving the number of times the key function block returned the key, for each value in the list. my %count_of_balls = count_by { $_->colour } @balls; Because the values returned by the key function are used as hash keys, they ought to either be strings, or at least well-behaved as strings (such as numbers, or object references which overload stringification in a suitable manner). =cut sub count_by(&@) { my $code = shift; my %counts; $counts{ $code->( local $_ = $_ ) }++ for @_; return %counts; } =head2 zip_by @vals = zip_by { ITEMFUNC } \@arr0, \@arr1, \@arr2,... Returns a list of each of the values returned by the function block, when invoked with values from across each each of the given ARRAY references. Each value in the returned list will be the result of the function having been invoked with arguments at that position, from across each of the arrays given. my @transposition = zip_by { [ @_ ] } @matrix; my @names = zip_by { "$_[1], $_[0]" } \@firstnames, \@surnames; print zip_by { "$_[0] => $_[1]\n" } [ keys %hash ], [ values %hash ]; If some of the arrays are shorter than others, the function will behave as if they had C in the trailing positions. The following two lines are equivalent: zip_by { f(@_) } [ 1, 2, 3 ], [ "a", "b" ] f( 1, "a" ), f( 2, "b" ), f( 3, undef ) The item function is called by C, so if it returns a list, the entire list is included in the result. This can be useful for example, for generating a hash from two separate lists of keys and values my %nums = zip_by { @_ } [qw( one two three )], [ 1, 2, 3 ]; # %nums = ( one => 1, two => 2, three => 3 ) (A function having this behaviour is sometimes called C, e.g. in Haskell, but that name would not fit the naming scheme used by this module). =cut sub zip_by(&@) { my $code = shift; @_ or return; my $len = 0; scalar @$_ > $len and $len = scalar @$_ for @_; return map { my $idx = $_; $code->( map { $_[$_][$idx] } 0 .. $#_ ) } 0 .. $len-1; } =head2 unzip_by $arr0, $arr1, $arr2, ... = unzip_by { ITEMFUNC } @vals I Returns a list of ARRAY references containing the values returned by the function block, when invoked for each of the values given in the input list. Each of the returned ARRAY references will contain the values returned at that corresponding position by the function block. That is, the first returned ARRAY reference will contain all the values returned in the first position by the function block, the second will contain all the values from the second position, and so on. my ( $firstnames, $lastnames ) = unzip_by { m/^(.*?) (.*)$/ } @names; If the function returns lists of differing lengths, the result will be padded with C in the missing elements. This function is an inverse of L, if given a corresponding inverse function. =cut sub unzip_by(&@) { my $code = shift; my @ret; foreach my $idx ( 0 .. $#_ ) { my @slice = $code->( local $_ = $_[$idx] ); $#slice = $#ret if @slice < @ret; $ret[$_][$idx] = $slice[$_] for 0 .. $#slice; } return @ret; } =head2 extract_by @vals = extract_by { SELECTFUNC } @arr I Removes elements from the referenced array on which the selection function returns true, and returns a list containing those elements. This function is similar to C, except that it modifies the referenced array to remove the selected values from it, leaving only the unselected ones. my @red_balls = extract_by { $_->color eq "red" } @balls; # Now there are no red balls in the @balls array This function modifies a real array, unlike most of the other functions in this module. Because of this, it requires a real array, not just a list. This function is implemented by invoking C on the array, not by constructing a new list and assigning it. One result of this is that weak references will not be disturbed. extract_by { !defined $_ } @refs; will leave weak references weakened in the C<@refs> array, whereas @refs = grep { defined $_ } @refs; will strengthen them all again. =cut sub extract_by(&\@) { my $code = shift; my ( $arrref ) = @_; my @ret; for( my $idx = 0; ; $idx++ ) { last if $idx > $#$arrref; next unless $code->( local $_ = $arrref->[$idx] ); push @ret, splice @$arrref, $idx, 1, (); redo; } return @ret; } =head2 extract_first_by $val = extract_first_by { SELECTFUNC } @arr I A hybrid between L and C. Removes the first element from the referenced array on which the selection function returns true, returning it. As with L, this function requires a real array and not just a list, and is also implemented using C so that weak references are not disturbed. If this function fails to find a matching element, it will return an empty list in list context. This allows a caller to distinguish the case between no matching element, and the first matching element being C. =cut sub extract_first_by(&\@) { my $code = shift; my ( $arrref ) = @_; foreach my $idx ( 0 .. $#$arrref ) { next unless $code->( local $_ = $arrref->[$idx] ); return splice @$arrref, $idx, 1, (); } return; } =head2 weighted_shuffle_by @vals = weighted_shuffle_by { WEIGHTFUNC } @vals I Returns the list of values shuffled into a random order. The randomisation is not uniform, but weighted by the value returned by the C. The probabilty of each item being returned first will be distributed with the distribution of the weights, and so on recursively for the remaining items. =cut sub weighted_shuffle_by(&@) { my $code = shift; my @vals = @_; my @weights = map { $code->( local $_ = $_ ) } @vals; my @ret; while( @vals > 1 ) { my $total = 0; $total += $_ for @weights; my $select = int rand $total; my $idx = 0; while( $select >= $weights[$idx] ) { $select -= $weights[$idx++]; } push @ret, splice @vals, $idx, 1, (); splice @weights, $idx, 1, (); } push @ret, @vals if @vals; return @ret; } =head2 bundle_by @vals = bundle_by { BLOCKFUNC } $number, @vals I Similar to a regular C functional, returns a list of the values returned by C. Values from the input list are given to the block function in bundles of C<$number>. If given a list of values whose length does not evenly divide by C<$number>, the final call will be passed fewer elements than the others. =cut sub bundle_by(&@) { my $code = shift; my $n = shift; my @ret; for( my ( $pos, $next ) = ( 0, $n ); $pos < @_; $pos = $next, $next += $n ) { $next = @_ if $next > @_; push @ret, $code->( @_[$pos .. $next-1] ); } return @ret; } =head1 TODO =over 4 =item * XS implementations These functions are currently all written in pure perl. Some at least, may benefit from having XS implementations to speed up their logic. =item * Merge into L or L This module shouldn't really exist. The functions should instead be part of one of the existing modules that already contain many list utility functions. Having Yet Another List Utilty Module just worsens the problem. I have attempted to contact the authors of both of the above modules, to no avail; therefore I decided it best to write and release this code here anyway so that it is at least on CPAN. Once there, we can then see how best to merge it into an existing module. I: As I am now the maintainer of L, some amount of merging/copying should be possible. However, given the latter's key position in the core F distribution and head of the "CPAN River" I am keen not to do this wholesale, but a selected pick of what seems best, by a popular consensus. =item * C and C-like functions Consider perhaps head_before { COND } LIST # excludes terminating element head_upto { COND } LIST # includes terminating element tail_since { COND } LIST # includes initiating element tail_after { COND } LIST # excludes initiating element (See also L). =back =head1 AUTHOR Paul Evans =cut 0x55AA; List-UtilsBy-0.11/t000755001750001750 013234447567 12742 5ustar00leoleo000000000000List-UtilsBy-0.11/t/00use.t000444001750001750 14713234447567 14202 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use_ok( 'List::UtilsBy' ); done_testing; List-UtilsBy-0.11/t/01sort_by.t000444001750001750 163313234447567 15111 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( sort_by rev_sort_by ); is_deeply( [ sort_by { } ], [], 'empty list' ); is_deeply( [ sort_by { $_ } "a" ], [ "a" ], 'unit list' ); is_deeply( [ sort_by { my $ret = $_; undef $_; $ret } "a" ], [ "a" ], 'localises $_' ); is_deeply( [ sort_by { $_ } "a", "b" ], [ "a", "b" ], 'identity function no-op' ); is_deeply( [ sort_by { $_ } "b", "a" ], [ "a", "b" ], 'identity function on $_' ); is_deeply( [ sort_by { $_[0] } "b", "a" ], [ "a", "b" ], 'identity function on $_[0]' ); # list reverse on a single element is a no-op; scalar reverse will swap the # characters. This test also ensures the correct context is seen by the function is_deeply( [ sort_by { reverse $_ } "az", "by" ], [ "by", "az" ], 'reverse function' ); is_deeply( [ rev_sort_by { $_ } "b", "a" ], [ "b", "a" ], 'reverse sort identity function on $_' ); done_testing; List-UtilsBy-0.11/t/02nsort_by.t000444001750001750 177013234447567 15272 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( nsort_by rev_nsort_by ); is_deeply( [ nsort_by { } ], [], 'empty list' ); is_deeply( [ nsort_by { $_ } 1 ], [ 1 ], 'unit list' ); is_deeply( [ nsort_by { my $ret = $_; undef $_; $ret } 10 ], [ 10 ], 'localises $_' ); is_deeply( [ nsort_by { $_ } 20, 25 ], [ 20, 25 ], 'identity function no-op' ); is_deeply( [ nsort_by { $_ } 25, 20 ], [ 20, 25 ], 'identity function on $_' ); is_deeply( [ nsort_by { $_[0] } 30, 35 ], [ 30, 35 ], 'identity function on $_[0]' ); is_deeply( [ nsort_by { length $_ } "a", "bbb", "cc" ], [ "a", "cc", "bbb" ], 'length function' ); # List context would yield the matches and fail, scalar context would yield # the count and be correct is_deeply( [ nsort_by { () = m/(a)/g } "apple", "hello", "armageddon" ], [ "hello", "apple", "armageddon" ], 'scalar context' ); is_deeply( [ rev_nsort_by { length $_ } "a", "bbb", "cc" ], [ "bbb", "cc", "a" ], 'reverse sort length function' ); done_testing; List-UtilsBy-0.11/t/03max_min_by.t000444001750001750 464113234447567 15556 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( max_by nmax_by min_by nmin_by minmax_by nminmax_by ); # max_by { is_deeply( [ max_by {} ], [], 'empty list yields empty' ); is_deeply( ( scalar max_by { $_ } 10 ), 10, 'unit list yields value in scalar context' ); is_deeply( [ max_by { $_ } 10 ], [ 10 ], 'unit list yields unit list value' ); is_deeply( ( scalar max_by { $_ } 10, 20 ), 20, 'identity function on $_' ); is_deeply( ( scalar max_by { $_[0] } 10, 20 ), 20, 'identity function on $_[0]' ); is_deeply( ( scalar max_by { length $_ } "a", "ccc", "bb" ), "ccc", 'length function' ); is_deeply( ( scalar max_by { length $_ } "a", "ccc", "bb", "ddd" ), "ccc", 'ties yield first in scalar context' ); is_deeply( [ max_by { length $_ } "a", "ccc", "bb", "ddd" ], [ "ccc", "ddd" ], 'ties yield all maximal in list context' ); is_deeply( ( scalar nmax_by { $_ } 10, 20 ), 20, 'nmax_by alias' ); } # min_by { is_deeply( [ min_by {} ], [], 'empty list yields empty' ); is_deeply( ( scalar min_by { $_ } 10 ), 10, 'unit list yields value in scalar context' ); is_deeply( [ min_by { $_ } 10 ], [ 10 ], 'unit list yields unit list value' ); is_deeply( ( scalar min_by { $_ } 10, 20 ), 10, 'identity function on $_' ); is_deeply( ( scalar min_by { $_[0] } 10, 20 ), 10, 'identity function on $_[0]' ); is_deeply( ( scalar min_by { length $_ } "a", "ccc", "bb" ), "a", 'length function' ); is_deeply( ( scalar min_by { length $_ } "a", "ccc", "bb", "e" ), "a", 'ties yield first in scalar context' ); is_deeply( [ min_by { length $_ } "a", "ccc", "bb", "ddd", "e" ], [ "a", "e" ], 'ties yield all minimal in list context' ); is_deeply( ( scalar nmin_by { $_ } 10, 20 ), 10, 'nmin_by alias' ); } # minmax_by { is_deeply( [ minmax_by {} ], [], 'empty list yields empty' ); is_deeply( [ minmax_by { $_ } 10 ], [ 10, 10, ], 'unit list yields value twice' ); is_deeply( [ minmax_by { $_ } 10, 20, 30, 40, 50 ], [ 10, 50 ], 'identity function on $_' ); is_deeply( [ minmax_by { $_[0] } 10, 20, 30, 40, 50 ], [ 10, 50 ], 'identity function on $_[0]' ); is_deeply( [ minmax_by { $_ } 50, 40, 30, 20, 10 ], [ 10, 50 ], 'identity function on reversed input' ); is_deeply( [ minmax_by { length $_ } "a", "ccc", "bb" ], [ "a", "ccc" ], 'length function' ); is_deeply( [ nminmax_by { $_ } 10 ], [ 10, 10, ], 'nminmax_by alias' ); } done_testing; List-UtilsBy-0.11/t/05uniq_by.t000444001750001750 124213234447567 15076 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( uniq_by ); is_deeply( [ uniq_by { } ], [], 'empty list' ); is_deeply( [ uniq_by { $_ } "a" ], [ "a" ], 'unit list' ); is_deeply( [ uniq_by { my $ret = $_; undef $_; $ret } "a" ], [ "a" ], 'localises $_' ); is_deeply( [ uniq_by { $_ } "a", "b" ], [ "a", "b" ], 'identity function no-op' ); is_deeply( [ uniq_by { $_ } "b", "a" ], [ "b", "a" ], 'identity function on $_' ); is_deeply( [ uniq_by { $_[0] } "b", "a" ], [ "b", "a" ], 'identity function on $_[0]' ); is_deeply( [ uniq_by { length $_ } "a", "b", "cc", "dd", "eee" ], [ "a", "cc", "eee" ], 'length function' ); done_testing; List-UtilsBy-0.11/t/06partition_by.t000444001750001750 151713234447567 16141 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( partition_by ); is_deeply( { partition_by { } }, {}, 'empty list' ); is_deeply( { partition_by { $_ } "a" }, { a => [ "a" ] }, 'unit list' ); is_deeply( { partition_by { my $ret = $_; undef $_; $ret } "a" }, { a => [ "a" ] }, 'localises $_' ); is_deeply( { partition_by { "all" } "a", "b" }, { all => [ "a", "b" ] }, 'constant function preserves order' ); is_deeply( { partition_by { "all" } "b", "a" }, { all => [ "b", "a" ] }, 'constant function preserves order' ); is_deeply( { partition_by { $_[0] } "b", "a" }, { a => [ "a" ], b => [ "b" ] }, 'identity function on $_[0]' ); is_deeply( { partition_by { length $_ } "a", "b", "cc", "dd", "eee" }, { 1 => [ "a", "b" ], 2 => [ "cc", "dd" ], 3 => [ "eee" ] }, 'length function' ); done_testing; List-UtilsBy-0.11/t/07count_by.t000444001750001750 102313234447567 15251 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( count_by ); is_deeply( { count_by { } }, {}, 'empty list' ); is_deeply( { count_by { $_ } "a" }, { a => 1 }, 'unit list' ); is_deeply( { count_by { "all" } "a", "b" }, { all => 2 }, 'constant function' ); is_deeply( { count_by { $_[0] } "b", "a" }, { a => 1, b => 1 }, 'identity function on $_[0]' ); is_deeply( { count_by { length $_ } "a", "b", "cc", "dd", "eee" }, { 1 => 2, 2 => 2, 3 => 1 }, 'length function' ); done_testing; List-UtilsBy-0.11/t/08zip_by.t000444001750001750 153213234447567 14731 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( zip_by ); is_deeply( [ zip_by { } ], [], 'empty list' ); is_deeply( [ zip_by { [ @_ ] } [ "a" ], [ "b" ], [ "c" ] ], [ [ "a", "b", "c" ] ], 'singleton lists' ); is_deeply( [ zip_by { [ @_ ] } [ "a", "b", "c" ] ], [ [ "a" ], [ "b" ], [ "c" ] ], 'narrow lists' ); is_deeply( [ zip_by { [ @_ ] } [ "a1", "a2" ], [ "b1", "b2" ] ], [ [ "a1", "b1" ], [ "a2", "b2" ] ], 'zip with []' ); is_deeply( [ zip_by { join ",", @_ } [ "a1", "a2" ], [ "b1", "b2" ] ], [ "a1,b1", "a2,b2" ], 'zip with join()' ); is_deeply( [ zip_by { [ @_ ] } [ 1 .. 3 ], [ 1 .. 2 ] ], [ [ 1, 1 ], [ 2, 2 ], [ 3, undef ] ], 'non-rectangular adds undef' ); is_deeply( { zip_by { @_ } [qw( one two three )], [ 1, 2, 3 ] }, { one => 1, two => 2, three => 3 }, 'itemfunc can return lists' ); done_testing; List-UtilsBy-0.11/t/09unzip_by.t000444001750001750 114513234447567 15275 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( unzip_by ); is_deeply( [ unzip_by { } ], [], 'empty list' ); is_deeply( [ unzip_by { $_ } "a", "b", "c" ], [ [ "a", "b", "c" ] ], 'identity function' ); is_deeply( [ unzip_by { $_, $_ } "a", "b", "c" ], [ [ "a", "b", "c" ], [ "a", "b", "c" ] ], 'clone function' ); is_deeply( [ unzip_by { m/(.)/g } "a1", "b2", "c3" ], [ [ "a", "b", "c" ], [ 1, 2, 3 ] ], 'regexp match function' ); is_deeply( [ unzip_by { m/(.)/g } "a", "b2", "c" ], [ [ "a", "b", "c" ], [ undef, 2, undef ] ], 'non-rectangular adds undef' ); done_testing; List-UtilsBy-0.11/t/10extract_by.t000444001750001750 377713234447567 15607 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw( weaken isweak ); use List::UtilsBy qw( extract_by extract_first_by ); { # We'll need a real array to work on my @numbers = ( 1 .. 10 ); is_deeply( [ extract_by { 0 } @numbers ], [], 'extract false returns none' ); is_deeply( \@numbers, [ 1 .. 10 ], 'extract false leaves array unchanged' ); is_deeply( [ extract_by { $_ % 3 == 0 } @numbers ], [ 3, 6, 9 ], 'extract div3 returns values' ); is_deeply( \@numbers, [ 1, 2, 4, 5, 7, 8, 10 ], 'extract div3 removes from array' ); is_deeply( [ extract_by { $_[0] < 5 } @numbers ], [ 1, 2, 4 ], 'extract $_[0] < 4 returns values' ); is_deeply( \@numbers, [ 5, 7, 8, 10 ], 'extract $_[0] < 4 removes from array' ); is_deeply( [ extract_by { 1 } @numbers ], [ 5, 7, 8, 10 ], 'extract true returns all' ); is_deeply( \@numbers, [], 'extract true leaves nothing' ); } { my @words = qw( here are some words ); is( ( extract_first_by { length == 4 } @words ), "here", 'extract first finds an element' ); is_deeply( \@words, [qw( are some words )], 'extract first leaves other matching elements' ); is_deeply( [ extract_first_by { length == 6 } @words ], [], 'extract first returns empty list on no match' ); } { my @refs = map { {} } 1 .. 3; weaken $_ for my @weakrefs = @refs; is_deeply( [ extract_by { !defined $_ } @weakrefs ], [], 'extract undef refs returns nothing yet' ); is( scalar @weakrefs, 3, 'extract undef refs leaves array unchanged' ); ok( isweak $weakrefs[0], "extract_by doesn't break weakrefs" ); undef $refs[0]; is_deeply( [ extract_by { !defined $_ } @weakrefs ], [ undef ], 'extract undef refs yields an undef' ); is( scalar @weakrefs, 2, 'extract undef refs removes from array' ); ok( isweak $weakrefs[0], "extract_by still doesn't break weakrefs" ); } done_testing; List-UtilsBy-0.11/t/11weighted_shuffle_by.t000444001750001750 142513234447567 17436 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use lib "."; use t::Unrandom; use List::UtilsBy qw( weighted_shuffle_by ); is_deeply( [ weighted_shuffle_by { } ], [], 'empty list' ); is_deeply( [ weighted_shuffle_by { 1 } "a" ], [ "a" ], 'unit list' ); my @vals = weighted_shuffle_by { 1 } "a", "b", "c"; is_deeply( [ sort @vals ], [ "a", "b", "c" ], 'set of return values' ); my %got; unrandomly { my $order = join "", weighted_shuffle_by { { a => 1, b => 2, c => 3 }->{$_} } qw( a b c ); $got{$order}++; }; my %expect = ( 'abc' => 1 * 2, 'acb' => 1 * 3, 'bac' => 2 * 1, 'bca' => 2 * 3, 'cab' => 3 * 1, 'cba' => 3 * 2, ); is_deeply( \%got, \%expect, 'Got correct distribution of ordering counts' ); done_testing; List-UtilsBy-0.11/t/12bundle_by.t000444001750001750 127713234447567 15401 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use List::UtilsBy qw( bundle_by ); is_deeply( [ bundle_by { $_[0] } 1, (1, 2, 3) ], [ 1, 2, 3 ], 'bundle_by 1' ); is_deeply( [ bundle_by { $_[0] } 2, (1, 2, 3, 4) ], [ 1, 3 ], 'bundle_by 2 first' ); is_deeply( [ bundle_by { @_ } 2, (1, 2, 3, 4) ], [ 1, 2, 3, 4 ], 'bundle_by 2 all' ); is_deeply( [ bundle_by { [ @_ ] } 2, (1, 2, 3, 4) ], [ [ 1, 2 ], [ 3, 4 ] ], 'bundle_by 2 [all]' ); is_deeply( { bundle_by { uc $_[1] => $_[0] } 2, qw( a b c d ) }, { B => "a", D => "c" }, 'bundle_by 2 constructing hash' ); is_deeply( [ bundle_by { [ @_ ] } 2, (1, 2, 3) ], [ [ 1, 2 ], [ 3 ] ], 'bundle_by 2 yields short final bundle' ); done_testing; List-UtilsBy-0.11/t/99pod.t000444001750001750 25713234447567 14214 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); List-UtilsBy-0.11/t/Unrandom.pm000444001750001750 244713234447567 15227 0ustar00leoleo000000000000package t::Unrandom; use strict; use warnings; use Exporter 'import'; our @EXPORT = qw( unrandomly ); our $randhook; *CORE::GLOBAL::rand = sub { $randhook ? $randhook->( $_[0] ) : rand $_[0] }; use constant VALUE => 0; use constant BELOW => 1; sub unrandomly(&) { my $code = shift; my @rands; my $randidx; local $randhook = sub { my ( $below ) = @_; if( $randidx > $#rands ) { push @rands, [ 0, $below ]; $randidx++; return 0; } if( $below != $rands[$randidx][BELOW] ) { die "ARGH! The function under test is nondeterministic!\n"; } if( $randidx < $#rands and $rands[$randidx+1][VALUE] == $rands[$randidx+1][BELOW]-1 ) { die "Fell off the edge" if $rands[$randidx][VALUE] == $rands[$randidx][BELOW]-1; splice @rands, $randidx+1, @rands-$randidx, (); $rands[$randidx][VALUE]++; return $rands[$randidx++][VALUE]; } elsif( $randidx == $#rands ) { $rands[$randidx][VALUE]++; return $rands[$randidx++][VALUE]; } else { return $rands[$randidx++][VALUE]; } }; while(1) { my $more = 0; $_->[VALUE] < $_->[BELOW]-1 and $more = 1 for @rands; last if @rands and !$more; $randidx = 0; $code->(); } } 1;