File Coverage

blib/lib/List/Tuples.pm
Criterion Covered Total %
statement 19 74 25.6
branch 0 38 0.0
condition n/a
subroutine 7 10 70.0
pod 3 3 100.0
total 29 125 23.2


line stmt bran cond sub pod time code
1              
2             package List::Tuples ;
3              
4 1     1   82349 use strict;
  1         4  
  1         48  
5 1     1   6 use warnings ;
  1         2  
  1         61  
6              
7             BEGIN
8             {
9 1         13 use Sub::Exporter -setup =>
10             {
11             exports => [ qw(tuples hash_tuples ref_mesh) ],
12             groups =>
13             {
14             all => [ qw(tuples hash_tuples ref_mesh) ],
15             }
16 1     1   1198 };
  1         45300  
17            
18 1     1   575 use vars qw ($VERSION);
  1         2  
  1         54  
19 1     1   18 $VERSION = '0.04' ;
20             }
21              
22             #-------------------------------------------------------------------------------
23              
24 1     1   1379 use Readonly ;
  1         5663  
  1         68  
25 1     1   1216 use Carp::Diagnostics qw(cluck carp croak confess) ;
  1         2153506  
  1         10  
26              
27             #-------------------------------------------------------------------------------
28              
29             =head1 NAME
30              
31             List::Tuples - Makes tuples from lists
32              
33             =head1 SYNOPSIS
34              
35             use List::Tuples qw(:all) ;
36            
37             my @tuples = tuples[2] => (1 .. 6) ;
38            
39             # is equivalent to:
40            
41             my @tuples =
42             (
43             [1, 2],
44             [3, 4],
45             [5, 6],
46             ) ;
47            
48             #-------------------------------------------------------
49            
50             my @meshed_list = ref_mesh([1 .. 3], ['a' .. 'b'], ['*']) ;
51            
52             # is equivalent to:
53            
54             my @meshed_list = (1, 'a', '*', 2, 'b', undef, 3, undef, undef) ;
55            
56             #-------------------------------------------------------
57            
58             my @hashes = hash_tuples ['key', 'other_key'] => (1 .. 5) ;
59            
60             # is equivalent to :
61            
62             my @hashes =
63             (
64             {key => 1, other_key => 2},
65             {key => 3, other_key => 4},
66             {key => 5, other_key => undef},
67             ) ;
68              
69             =head1 DESCRIPTION
70              
71             This module defines subroutines that let you create tuples.
72              
73             =head1 DOCUMENTATION
74              
75             Ever got frustrated that you couldn't easily get tuples into map{} or
76             create multiple hashes from an ordered list?
77              
78             Jonathan Scott in In "Everyday Perl 6" L writes:
79              
80             # Perl 6 # Perl 5
81             for @array -> $a { ... } for my $a (@array) { ... }
82             for @array -> $a, $b { ... } # too complex :)
83              
84             The following subroutines will simplify your job. They could certainly be more effective implemented
85             directly in the language, IE in Perl6. If you have millions of tuples to handle, you may want monitor memory usage.
86              
87             =head1 SUBROUTINES
88              
89             =cut
90              
91             #----------------------------------------------------------------------
92              
93             sub tuples
94             {
95              
96             =head2 tuples([$limit], \@size, @list)
97              
98             B will extract B<$size> elements from B<@lists> and group them in an array reference.
99             It will extract as many tuples as possible up to the, optional, B<$limit> you pass as argument.
100              
101             tuples 3 => [2] => (1 .. 14); # 3 tuples with 2 elements are returned
102             tuples[2] => (1 .. 14); # 7 tuples with 2 elements are returned
103            
104             for my $tuple (tuples[2] => @array)
105             {
106             print "[$tuple->[0], $tuple->[1]]\n" ;
107             }
108            
109              
110             B
111              
112             =over 2
113              
114             =item * $limit - an optional maximum number of tuples to create
115              
116             =item * \@size - an array reference containing the number of elements in a tuple
117              
118             =item * @list - a list to be split into tuples
119              
120             =back
121              
122             B
123              
124             =over 2
125              
126             =item * A list of tuples (array references)
127              
128             =back
129              
130             =head3 Input list with insufficient elements
131              
132             my @tuples = tuples[2] => (1 .. 3)) ;
133            
134             # is equivalent to:
135            
136             my @tuples =
137             (
138             [1, 2],
139             [3],
140             ) ;
141              
142             =head3 Diagnostics
143              
144             =cut
145              
146 0     0 1   my ($limit, $size, @array) = @_ ;
147              
148 0 0         if ('ARRAY' eq ref $limit)
149             {
150             # handle optional limit
151 0 0         unshift @array, $size if defined $size ;
152 0           $size = $limit ;
153 0           $limit = undef ;
154             }
155              
156 0           my $number_of_tuples = 0 ;
157              
158 0 0         if('ARRAY' eq ref $size)
159             {
160 0           $size = $size->[0] ;
161            
162 0 0         if(defined $size)
163             {
164 0 0         if($size > 0)
165             {
166 0           $number_of_tuples = @array / $size ;
167 0 0         $number_of_tuples++ if @array % $size ;
168             }
169             else
170             {
171 0           confess
172             (
173             'Error: List::Tuples::tuples expects tuple size to be positive!',
174             <<'END_OF_POD',
175              
176             =over
177              
178             =item * Error: List::Tuples::tuples expects tuple size to be positive!
179              
180             example:
181              
182             my @tuples = tuples[2] => @list ;
183             ^
184             `- size must be positive
185              
186             =back
187              
188             =cut
189              
190             END_OF_POD
191             ) ;
192             }
193             }
194             else
195             {
196 0           confess
197             (
198             'Error: List::Tuples::tuples expects a tuple size!',
199             <<'END_OF_POD',
200              
201             =over
202              
203             =item * Error: List::Tuples::tuples expects a tuple size!
204              
205             example:
206              
207             my @tuples = tuples[2] => @list ;
208             ^
209             `- size must be defined
210              
211             =back
212              
213             =cut
214              
215             END_OF_POD
216             ) ;
217             }
218            
219 0 0         if(defined $limit)
220             {
221 0 0         if($limit > 0)
222             {
223 0 0         $number_of_tuples = $number_of_tuples > $limit ? $limit : $number_of_tuples ;
224             }
225             else
226             {
227 0           confess
228             (
229             'Error: List::Tuples::tuples expects tuple limit to be positive!',
230             <<'END_OF_POD',
231              
232             =over
233              
234             =item * Error: List::Tuples::tuples expects tuple limit to be positive !
235              
236             example:
237              
238             my @tuples = tuples 3 => [2] => @list ;
239             ^
240             `- limit must be positive
241              
242             =back
243              
244             =cut
245              
246             END_OF_POD
247             ) ;
248             }
249             }
250             }
251             else
252             {
253 0           confess
254             (
255             'Error: List::Tuples::tuples expects an array reference as size argument!',
256             <<'END_OF_POD',
257              
258             =over
259              
260             =item * Error: List::Tuples::tuples expects an array reference as size argument!
261              
262             example:
263              
264             my @tuples = tuples[2] => @list ;
265             ^
266             `- size must be in an array reference
267              
268             =back
269              
270             =cut
271              
272             END_OF_POD
273             ) ;
274             }
275            
276 0 0         if(@array)
277             {
278             return
279             (
280 0           map{[splice(@array, 0, $size)] } (1 .. $number_of_tuples)
  0            
281             ) ;
282             }
283             else
284             {
285 0           return ;
286             }
287             }
288              
289              
290             #-------------------------------------------------------------------------------------------------------------
291              
292             sub ref_mesh
293             {
294              
295             =head2 ref_mesh(\@array1, \@array2, ...)
296              
297             Mixes elements from arrays, one element at the time.
298              
299             my @list =
300             ref_mesh
301             ['mum1', 'mum2', 'mum3'],
302             ['dad1', 'dad2'],
303             [['child1_1', 'child1_2'], [], ['child3_1']] ;
304            
305             # is equivalent to :
306            
307             my @list =
308             (
309             'mum1',
310             'dad1',
311             [child1_1, 'child1_2'],
312             'mum2',
313             'dad2',
314             [],
315             'mum3',
316             'undef,
317             [child3_1]
318             ) ;
319              
320             This is equivalent to B from L except the fact it takes arrays references instead for lists.
321             The implementation is directly taken from L.
322              
323             B
324              
325             =over 2
326              
327             =item * a list of array reference
328              
329             =back
330              
331             B
332              
333             =over 2
334              
335             =item * a list consisting of the first elements of each array reference, then the second, then the third, etc, until all arrays are exhausted
336              
337             =back
338              
339             =head3 Diagnostics
340              
341             =cut
342              
343 0     0 1   my (@array_references) = @_ ;
344              
345 0           Readonly my $INVALID_MAXIMUM_VALUE => -1 ;
346              
347 0           my $max = $INVALID_MAXIMUM_VALUE ;
348 0           my $index = 0 ;
349              
350 0           for my $array_ref (@array_references)
351             {
352 0 0         confess
353             (
354             "Error: List::Tuples::ref_mesh: element '$index' is not an array reference!",
355             <<"END_OF_POD",
356              
357             =over
358              
359             =item * Error: List::Tuples::ref_mesh: element '$index' is not an array reference!
360              
361             example:
362              
363             my \@list = ref_mesh([1, 2], [5, 10], [10, 20], ...) ;
364             ^
365             `- arguments must be array references
366              
367             =back
368              
369             =cut
370              
371             END_OF_POD
372             ) unless 'ARRAY' eq ref $array_ref ;
373            
374 0 0         $max < $#{$array_ref} && ($max = $#{$array_ref} ) ;
  0            
  0            
375            
376 0           $index++ ;
377             }
378              
379             return
380             (
381 0           map
382             {
383 0           my $ix = $_ ;
384 0           map {$_->[$ix]}
  0            
385             @array_references
386             }
387             0..$max
388             ) ;
389             }
390              
391             #-------------------------------------------------------------------------------------------------------------
392              
393             sub hash_tuples
394             {
395              
396             =head2 hash_tuples([$limit], \@hash_keys, @input_array)
397              
398             B uses elements from \@input_array and combine them with \@hash_keys to create hash references.
399             It will create as many hashes as possible up to the, optional, $limit.
400              
401             my @hashes =
402             hash_tuples
403             ['Mum', 'Dad', 'Children'] =>
404             'Lena', 'Nadim', ['Yasmin', 'Miriam'],
405             'Monika', 'ola', ['astrid'] ;
406            
407             # is equivalent to:
408            
409             my @hashes =
410             (
411             {
412             'Mum' => 'Lena',
413             'Children' => ['Yasmin','Miriam'],
414             'Dad' => 'Nadim'
415             },
416             {
417             'Mum' => 'Monika',
418             'Children' => ['astrid'],
419             'Dad' => 'ola'
420             }
421             ) ;
422            
423            
424             for my $tuple (hash_tuples(['a', 'b'] => @array))
425             {
426             print $tuple->{a} . "\n" ;
427             print $tuple->{b} . "\n" ;
428             }
429              
430             B
431              
432             =over 2
433              
434             =item * $limit - an optional maximum number of hashes to create
435              
436             =item * \@hash_keys - an array reference containing the list of keys apply to the input array
437              
438             =item * \@input_array- an array reference. the array contains the elements to extract
439              
440             =back
441              
442             B
443              
444             =over 2
445              
446             =item * A list of hashes
447              
448             =back
449              
450             =head3 Diagnostics
451              
452             =cut
453              
454 0     0 1   my ($limit, $hash_keys, @input_array) = @_ ;
455              
456 0 0         if ('ARRAY' eq ref $limit)
457             {
458 0 0         unshift @input_array, $hash_keys if defined $hash_keys ;
459 0           $hash_keys = $limit ;
460 0           $limit = undef ;
461             }
462            
463 0 0         if('ARRAY' eq ref $hash_keys)
464             {
465 0 0         unless(@{$hash_keys})
  0            
466             {
467 0           confess
468             (
469             'Error: List::Tuples::hash_tuples expects at least one key in the key list!',
470             <<'END_OF_POD',
471              
472             =over
473              
474             =item * Error: List::Tuples::hash_tuples expects at least one key in the key list!
475              
476             example:
477              
478             my @hashes = hash_tuples['Mum', 'Dad', 'Children'] => @list ;
479             ^
480             `- key list must contain at least one keys
481              
482             =back
483              
484             =cut
485              
486             END_OF_POD
487             ) ;
488             }
489            
490 0 0         if(defined $limit)
491             {
492 0 0         if($limit <= 0)
493             {
494 0           confess
495             (
496             'Error: List::Tuples::hash_tuples expects tuple limit to be positive!',
497             <<'END_OF_POD',
498              
499             =over
500              
501             =item * Error: List::Tuples::hash_tuples expects tuple limit to be positive!
502              
503             example:
504              
505             my @hashes = hash_tuples 3 => ['Mum', 'Dad', 'Children'] => @list ;
506             ^
507             `- limit must be positive
508              
509             =back
510              
511             =cut
512              
513             END_OF_POD
514             ) ;
515             }
516             }
517             }
518             else
519             {
520 0           confess
521             (
522             'Error: List::Tuples::hash_tuples expects an array reference to define the keys!',
523             <<'END_OF_POD',
524              
525             =over
526              
527             =item * Error: List::Tuples::hash_tuples expects an array reference to define the keys!
528              
529             example:
530              
531             my @hashes = hash_tuples ['Mum', 'Dad', 'Children'] => @list ;
532             ^
533             `- key list must be an array reference
534              
535             =back
536              
537             =cut
538              
539             END_OF_POD
540             ) ;
541             }
542            
543 0 0         if(@input_array)
544             {
545             return
546             (
547 0           map
548             {
549 0           {
550             ref_mesh($hash_keys => $_)
551             }
552             }
553 0           tuples $limit => [scalar(@{$hash_keys})] => @input_array
554             ) ;
555             }
556             else
557             {
558 0           return ;
559             }
560             }
561              
562              
563             #-------------------------------------------------------------------------------------------------------------
564              
565             1 ;
566              
567             =head1 BUGS AND LIMITATIONS
568              
569             None so far.
570              
571             =head1 AUTHOR
572              
573             Khemir Nadim ibn Hamouda
574             CPAN ID: NKH
575             mailto:nadim@khemir.net
576              
577             =head1 LICENSE AND COPYRIGHT
578              
579             This program is free software; you can redistribute
580             it and/or modify it under the same terms as Perl itself.
581              
582             =head1 SUPPORT
583              
584             You can find documentation for this module with the perldoc command.
585              
586             perldoc List::Tuples
587              
588             You can also look for information at:
589              
590             =over 4
591              
592             =item * AnnoCPAN: Annotated CPAN documentation
593              
594             L
595              
596             =item * RT: CPAN's request tracker
597              
598             Please report any bugs or feature requests to L .
599              
600             We will be notified, and then you'll automatically be notified of progress on
601             your bug as we make changes.
602              
603             =item * Search CPAN
604              
605             L
606              
607             =back
608              
609             =head1 SEE ALSO
610              
611             L
612              
613             =cut