File Coverage

blib/lib/Data/PowerSet.pm
Criterion Covered Total %
statement 77 77 100.0
branch 46 46 100.0
condition 6 6 100.0
subroutine 9 9 100.0
pod 6 6 100.0
total 144 144 100.0


line stmt bran cond sub pod time code
1             # Data::PowerSet.pm
2             #
3             # Copyright (c) 2005-2008 David Landgren
4             # All rights reserved
5              
6             package Data::PowerSet;
7              
8 2     2   1924 use strict;
  2         4  
  2         74  
9 2     2   11 use Exporter;
  2         4  
  2         97  
10              
11 2     2   11 use vars qw/$VERSION @ISA @EXPORT_OK/;
  2         8  
  2         2703  
12             $VERSION = '0.05';
13             @ISA = ('Exporter');
14              
15             =head1 NAME
16              
17             Data::PowerSet - Generate all subsets of a list of elements
18              
19             =head1 VERSION
20              
21             This document describes version 0.05 of Data::PowerSet, released
22             2008-05-13.
23              
24             =head1 SYNOPSIS
25              
26             use Data::PowerSet 'powerset';
27              
28             my $powerset = powerset( 3, 1, 4 );
29             for my $p (@$powerset) {
30             print "@$p\n";
31             }
32              
33             # prints
34             3 1 4
35             1 4
36             3 4
37             4
38             3 1
39             1
40             3
41              
42             An object-oriented interface is also available;
43              
44             my $d = Data::PowerSet->new( 3, 1, 4 );
45             while (my $r = $d->next) {
46             print "@$r\n";
47             }
48             # produces the same output as above
49              
50             =head1 DESCRIPTION
51              
52             C takes a list and returns all possible
53             combinations of the elements appearing in the list without replacement.
54              
55             =head1 EXPORTABLE FUNCTIONS
56              
57             =over 8
58              
59             =item powerset
60              
61             The C function takes an array (or a reference to an array) on
62             input and returns a reference to an array of arrays containing all the
63             possible unique combinations of elements.
64              
65             It is also possible to supply a reference to hash as the first
66             parameter to tweak the behaviour. See the C method for a
67             description of what keys can be specified.
68              
69             powerset( 2, 5, 10, 17 );
70              
71             powerset( {min => 1}, qw(a b c d) );
72              
73             powerset( [qw[ bodine mondaugen gadrulfi fleische eigenvalue ]] );
74              
75             =cut
76              
77             push @EXPORT_OK, 'powerset';
78             sub powerset {
79 6     6 1 31446 my %args;
80 6 100       29 if (ref($_[0]) eq 'HASH') {
81 5         15 %args = %{shift @_};
  5         33  
82             }
83 6 100       28 my @list = ref($_[0]) eq 'ARRAY' ? @{shift @_} : @_;
  1         5  
84              
85 6 100       21 $args{min} = exists $args{min} ? $args{min} < 0 ? 0 : $args{min} : 0;
    100          
86 6 100       25 $args{max} = exists $args{max} ? $args{max} > @list ? @list : $args{max} : @list;
    100          
87              
88 6 100       19 ($args{min}, $args{max}) = ($args{max}, $args{min})
89             if $args{max} < $args{min};
90              
91 6         14 my $lim = 2 ** @list - 1;
92 6         15 my @powerset;
93 6         27 while( $lim >= 0 ) {
94 52         118 my @set;
95 52         60 my $mask = $lim--;
96 52         56 my $offset = 0;
97 52         156 while( $mask ) {
98 122 100       249 push @set, $list[$offset] if $mask & 1;
99 122         108 $mask >>= 1;
100 122         199 ++$offset;
101             }
102 52 100 100     289 if( @set >= $args{min} and @set <= $args{max} ) {
103 43 100       270 push @powerset, exists $args{join}
104             ? join( $args{join}, @set)
105             : [@set];
106             }
107             }
108 6         27 return \@powerset;
109             }
110              
111             =back
112              
113             =head1 METHODS
114              
115             The object-oriented interface provided by the module is implemented
116             with the following methods.
117              
118             =over 8
119              
120             =item new
121              
122             Creates a new C object.
123              
124             my $ps = Data::PowerSet->new( qw( foo bar grault waldo ));
125              
126             A reference to a hash may
127             be supplied, to change the way the object behaves.
128              
129             =over 8
130              
131             =item B
132              
133             Minimum number of elements present in the selection.
134              
135             Note that the empty set (no elements) is quite valid, according to
136             the mathematical definition of a power set. If this is not what you
137             expect, setting C to 1 will effectively cause the empty set to
138             be excluded from the result.
139              
140             my $ps = Data::PowerSet->new( {min=>2}, 2, 3, 5, 8, 11 );
141              
142             In the above object, no returned list will contain fewer
143             than 2 elements.
144              
145             =item B
146              
147             Maximum number of elements present in the selection.
148              
149             my $ps = Data::PowerSet->new( {max=>3}, 2, 3, 5, 8, 11 );
150              
151             In the above object, no returned list will contain more
152             than 3 elements.
153              
154             =item B
155              
156             Perform a C on each returned list using the
157             specified value.
158              
159             my $ps = Data::Powerset->new( {join=>'-'}, 'a', 'b' );
160              
161             When this attribute is used, the C method will
162             return a scalar rather than a reference to an array.
163              
164             =back
165              
166             =cut
167              
168             sub new {
169 7     7 1 42524 my $class = shift;
170 7         11 my %args;
171 7 100       409 if( ref($_[0]) eq 'HASH' ) {
172 4         5 %args = %{shift(@_)};
  4         18  
173             }
174 7 100       26 if( ref($_[0]) eq 'ARRAY' ) {
175 2         5 $args{data} = shift @_;
176             }
177             else {
178 5         20 $args{data} = [@_],
179             }
180 7         9 $args{current} = 2**@{$args{data}}-1;
  7         25  
181              
182 7 100       30 $args{min} =
    100          
183             exists $args{min}
184             ? $args{min} < 0
185             ? 0 : $args{min}
186             : 0
187             ;
188              
189 4         13 $args{max} =
190             exists $args{max}
191 1         7 ? $args{max} > @{$args{data}}
192 3         9 ? @{$args{data}} : $args{max}
193 7 100       22 : @{$args{data}}
    100          
194             ;
195              
196 7 100       78 ($args{min}, $args{max}) = ($args{max}, $args{min})
197             if $args{max} < $args{min};
198 7         34 return bless \%args, $class;
199             }
200              
201             =item next
202              
203             Returns a reference to an array containing the next combination of
204             elements from the original list;
205              
206             my $ps = Data::PowerSet->new(qw(e t a i s o n));
207             my $first = $ps->next;
208             my $next = $ps->next;
209              
210             =cut
211              
212             sub next {
213 59     59 1 15259 my $self = shift;
214 59         64 my $ok = 0;
215 59         59 my @set;
216 59         141 until( $ok ) {
217 93 100       245 return undef unless $self->{current} >= 0;
218 88         231 my $mask = $self->{current}--;
219 88         106 my $offset = 0;
220 88         122 @set = ();
221 88         160 while( $mask ) {
222 309 100       632 push @set, $self->{data}[$offset] if $mask & 1;
223 309         261 $mask >>= 1;
224 309         495 ++$offset;
225             }
226 88 100 100     467 $ok = 1 if @set >= $self->{min} and @set <= $self->{max};
227             }
228 54 100       951 return exists $self->{join} ? join($self->{join}, @set) : \@set;
229             }
230              
231             =item reset
232              
233             Restart from the first combination of the list.
234              
235             =cut
236              
237             sub reset {
238 1     1 1 2 my $self = shift;
239 1         2 $self->{current} = 2**@{$self->{data}}-1;
  1         4  
240             }
241              
242             =item data
243              
244             Accept a new list of elements from which to draw combinations.
245              
246             $ps->data( qw(all new elements to use) );
247              
248             =cut
249              
250             sub data {
251 2     2 1 333 my $self = shift;
252 2         7 $self->{data} = [@_],
253 2         10 $self->{current} = 2**@{$self->{data}}-1;
254              
255 2 100       6 $self->{min} = @{$self->{data}} if $self->{min} > @{$self->{data}};
  1         3  
  2         9  
256 2 100       5 $self->{max} = @{$self->{data}} if $self->{max} > @{$self->{data}};
  1         4  
  2         7  
257             }
258              
259             =item count
260              
261             Returns the number of elements in the set. This can be used
262             to set C to the number of elements minus one, in order to
263             exclude the set of all elements, when the number of elements
264             is difficult to determine beforehand.
265              
266             =cut
267              
268             sub count {
269 1     1 1 708 my $self = shift;
270 1         2 return scalar(@{$self->{data}});
  1         5  
271             }
272              
273             =back
274              
275             =head1 DIAGNOSTICS
276              
277             None.
278              
279             =head1 NOTES
280              
281             Power sets grow exponentially. A power set of 10 elements returns
282             a more than one thousand results. A power set of 20 elements contains
283             more than one million results. The module is not expected to be put
284             to use in larger sets.
285              
286             A power set, by definition, includes the set of no elements and
287             the set of all elements. If these results are not desired, the
288             C and C methods or properties can be used to exclude
289             them from the results.
290              
291             This module works with perl version 5.005_04 and above.
292              
293             =head1 SEE ALSO
294              
295             =over 8
296              
297             =item L
298              
299             Another module that generates power sets. If I had managed to find
300             it in a search beforehand, I probably would have used it instead.
301             Nonetheless, C has a couple of features not
302             present in C, but otherwise both can be used
303             pretty much interchangeably.
304              
305             =item L
306              
307             A fast (no stacks, no recursion) method for generating permutations
308             and combinations of a set. A power set is merely the union of all
309             combinations (of differing lengths).
310              
311             =item L
312              
313             The wikipedia definition of a power set.
314              
315             =back
316              
317             =head1 BUGS
318              
319             None known. Please report all bugs at
320             L
321              
322             Make sure you include the output from the following two commands:
323              
324             perl -MData::PowerSet -le 'print Data::PowerSet::VERSION'
325             perl -V
326              
327             =head1 ACKNOWLEDGEMENTS
328              
329             This module is dedicated to Estelle Souche, who pointed out the very
330             elegant and obvious algorithm. Smylers suggested the name.
331              
332             =head1 AUTHOR
333              
334             David Landgren, copyright (C) 2005-2008. All rights reserved.
335              
336             http://www.landgren.net/perl/
337              
338             If you (find a) use this module, I'd love to hear about it.
339             If you want to be informed of updates, send me a note. You
340             know my first name, you know my domain. Can you guess my
341             e-mail address?
342              
343             =head1 LICENSE
344              
345             This library is free software; you can redistribute it and/or modify
346             it under the same terms as Perl itself.
347              
348             =cut
349              
350             'The Lusty Decadent Delights of Imperial Pompeii';