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'; |