File Coverage

blib/lib/Mojo/Collection/Role/UtilsBy.pm
Criterion Covered Total %
statement 38 38 100.0
branch n/a
condition n/a
subroutine 23 23 100.0
pod 17 17 100.0
total 78 78 100.0


line stmt bran cond sub pod time code
1             package Mojo::Collection::Role::UtilsBy;
2              
3 2     2   1140 use Role::Tiny;
  2         5  
  2         11  
4 2     2   757 use List::UtilsBy ();
  2         2297  
  2         33  
5 2     2   223 use Sub::Util ();
  2         214  
  2         114  
6              
7             our $VERSION = '0.001';
8              
9             requires 'new';
10              
11             foreach my $func (qw(nsort_by rev_nsort_by rev_sort_by sort_by
12             uniq_by weighted_shuffle_by zip_by)) {
13             my $sub = List::UtilsBy->can($func) || die "Function List::UtilsBy::$func not found";
14 2     2   11 no strict 'refs';
  2         4  
  2         198  
15             *$func = Sub::Util::set_subname __PACKAGE__ . "::$func", sub {
16 56     56 1 23590 my ($self, $code) = @_;
        56 1    
        56 1    
        56 1    
        56 1    
        56 1    
        56 1    
17 56         139 return ref($self)->new($sub->($code, @$self));
18             };
19             }
20              
21             foreach my $func (qw(max_by min_by)) {
22             my $sub = List::UtilsBy->can($func) || die "Function List::UtilsBy::$func not found";
23 2     2   11 no strict 'refs';
  2         4  
  2         710  
24             *$func = Sub::Util::set_subname __PACKAGE__ . "::$func", sub {
25 12     12 1 5733 my ($self, $code) = @_;
        12 1    
26 12         31 return scalar $sub->($code, @$self);
27             };
28             *{"all_$func"} = Sub::Util::set_subname __PACKAGE__ . "::all_$func", sub {
29 4     4 1 2048 my ($self, $code) = @_;
        4 1    
30 4         12 return ref($self)->new($sub->($code, @$self));
31             };
32             }
33              
34             sub bundle_by {
35 6     6 1 3618 my ($self, $code, $n) = @_;
36 6         18 return ref($self)->new(&List::UtilsBy::bundle_by($code, $n, @$self));
37             }
38              
39             sub count_by {
40 5     5 1 3057 my ($self, $code) = @_;
41 5         15 return +{ &List::UtilsBy::count_by($code, @$self) };
42             }
43              
44             sub extract_by {
45 6     6 1 5303 my ($self, $code) = @_;
46 6         18 return ref($self)->new(&List::UtilsBy::extract_by($code, \@$self));
47             }
48              
49             sub extract_first_by {
50 2     2 1 1928 my ($self, $code) = @_;
51 2         8 return scalar &List::UtilsBy::extract_first_by($code, \@$self);
52             }
53              
54             sub partition_by {
55 7     7 1 4218 my ($self, $code) = @_;
56 7         14 my $class = ref $self;
57 7     9   27 return +{ List::UtilsBy::bundle_by { ($_[0] => $class->new(@{$_[1]})) } 2,
  9         161  
  9         33  
58             &List::UtilsBy::partition_by($code, @$self) };
59             }
60              
61             sub unzip_by {
62 5     5 1 3377 my ($self, $code) = @_;
63 5         9 my $class = ref $self;
64 5         13 return $class->new(map { $class->new(@$_) }
  7         139  
65             &List::UtilsBy::unzip_by($code, @$self));
66             }
67              
68             1;
69              
70             =head1 NAME
71              
72             Mojo::Collection::Role::UtilsBy - List::UtilsBy methods for Mojo::Collection
73              
74             =head1 SYNOPSIS
75              
76             use Mojo::Collection 'c';
77             my $c = c(1..12)->with_roles('+UtilsBy');
78             say 'Reverse lexical order: ', $c->rev_sort_by(sub { $_ })->join(',');
79            
80             use List::Util 'product';
81             say "Product of 3 elements: $_" for $c->bundle_by(sub { product(@_) }, 3)->each;
82            
83             my $partitions = $c->partition_by(sub { $_ % 4 });
84             # { 0 => c(4,8,12), 1 => c(1,5,9), 2 => c(2,6,10), 3 => c(3,7,11) }
85            
86             my $halves_and_remainders = $c->unzip_by(sub { (int($_ / 2), $_ % 2) });
87             # c(c(0,1,1,2,2,3,3,4,4,5,5,6), c(1,0,1,0,1,0,1,0,1,0,1,0))
88            
89             my $transposed = $halves_and_remainders->zip_by(sub { c(@_) });
90             # c(c(0,1), c(1,0), c(1,1), c(2,0), c(2,1), c(3,0), c(3,1), c(4,0), c(4,1), c(5,0), c(5,1), c(6,0))
91            
92             my $evens = $c->extract_by(sub { $_ % 2 == 0 }); # $c now contains only odd numbers
93              
94             =head1 DESCRIPTION
95              
96             A role to augment L with methods that call functions from
97             L. With the exception of L and L which
98             pass multiple elements in C<@_>, all passed callbacks will be called with both
99             C<$_> and C<$_[0]> set to the current element in the iteration.
100              
101             =head1 METHODS
102              
103             L composes the following methods.
104              
105             =head2 all_max_by
106              
107             my $collection = $c->all_max_by(sub { $_->num });
108              
109             Return a new collection containing all of the elements that share the
110             numerically largest result from the passed function, using
111             L.
112              
113             =head2 all_min_by
114              
115             my $collection = $c->all_min_by(sub { $_->num });
116              
117             Return a new collection containing all of the elements that share the
118             numerically smallest result from the passed function, using
119             L.
120              
121             =head2 bundle_by
122              
123             my $collection = $c->bundle_by(sub { c(@_) }, $n);
124              
125             Return a new collection containing the results from the passed function, given
126             input elements in bundles of (up to) C<$n> at a time, using
127             L. The passed function will receive each bundle of
128             inputs in C<@_>, and will receive less than C<$n> if not enough elements remain.
129              
130             =head2 count_by
131              
132             my $hashref = $c->count_by(sub { $_->name });
133              
134             Return a hashref where the values are the number of times each key was returned
135             from the passed function, using L.
136              
137             =head2 extract_by
138              
139             my $collection = $c->extract_by(sub { $_->num > 5 });
140              
141             Remove elements from the collection that return true from the passed function,
142             and return a new collection containing the removed elements, using
143             L.
144              
145             =head2 extract_first_by
146              
147             my $element = $c->extract_first_by(sub { $_->name eq 'Fred' });
148              
149             Remove and return the first element from the collection that returns true from
150             the passed function, using L.
151              
152             =head2 max_by
153              
154             my $element = $c->max_by(sub { $_->num });
155              
156             Return the (first) element from the collection that returns the numerically
157             largest result from the passed function, using L.
158              
159             =head2 min_by
160              
161             my $element = $c->min_by(sub { $_->num });
162              
163             Return the (first) element from the collection that returns the numerically
164             smallest result from the passed function, using L.
165              
166             =head2 nsort_by
167              
168             my $collection = $c->nsort_by(sub { $_->num });
169              
170             Return a new collection containing the elements sorted numerically by the
171             results from the passed function, using L.
172              
173             =head2 partition_by
174              
175             my $hashref = $c->partition_by(sub { $_->name });
176              
177             Return a hashref where the values are collections of the elements that returned
178             that key from the passed function, using L.
179              
180             =head2 rev_nsort_by
181              
182             my $collection = $c->rev_nsort_by(sub { $_->num });
183              
184             Return a new collection containing the elements sorted numerically in reverse
185             by the results from the passed function, using L.
186              
187             =head2 rev_sort_by
188              
189             my $collection = $c->rev_sort_by(sub { $_->name });
190              
191             Return a new collection containing the elements sorted lexically in reverse
192             by the results from the passed function, using L.
193              
194             =head2 sort_by
195              
196             my $collection = $c->sort_by(sub { $_->name });
197              
198             Return a new collection containing the elements sorted lexically by the results
199             from the passed function, using L.
200              
201             =head2 uniq_by
202              
203             my $collection = $c->uniq_by(sub { $_->name });
204              
205             Return a new collection containing the elements that return stringwise unique
206             values from the passed function, using L.
207              
208             =head2 unzip_by
209              
210             my $collection = $c->unzip_by(sub { ($_->name, $_->num) });
211             my ($names, $nums) = @$collection_of_collections;
212              
213             Return a collection of collections where each collection contains the results
214             at the corresponding position from the lists returned by the passed function,
215             using L. If the lists are uneven, the collections
216             will contain C in the positions without a corresponding value.
217              
218             =head2 weighted_shuffle_by
219              
220             my $collection = $c->weighted_shuffle_by(sub { $_->num });
221              
222             Return a new collection containing the elements shuffled with weighting
223             according to the results from the passed function, using
224             L.
225              
226             =head2 zip_by
227              
228             my $collection = $c->zip_by(sub { c(@_) });
229              
230             Return a new collection containing the results from the passed function when
231             invoked with values from the corresponding position across all inner arrays,
232             using L. This method must be called on a collection
233             that only contains array references or collection objects. The passed function
234             will receive each list of elements in C<@_>. If the arrays are uneven, C
235             will be passed in the positions without a corresponding value.
236              
237             =head1 BUGS
238              
239             Report any issues on the public bugtracker.
240              
241             =head1 AUTHOR
242              
243             Dan Book
244              
245             =head1 COPYRIGHT AND LICENSE
246              
247             This software is Copyright (c) 2017 by Dan Book.
248              
249             This is free software, licensed under:
250              
251             The Artistic License 2.0 (GPL Compatible)
252              
253             =head1 SEE ALSO
254              
255             L, L