line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
20366
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
2
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
73
|
|
3
|
|
|
|
|
|
|
package Set::CartesianProduct::Lazy; |
4
|
|
|
|
|
|
|
{ |
5
|
|
|
|
|
|
|
$Set::CartesianProduct::Lazy::VERSION = '0.002'; |
6
|
|
|
|
|
|
|
} |
7
|
|
|
|
|
|
|
{ |
8
|
|
|
|
|
|
|
$Set::CartesianProduct::Lazy::DIST = 'Set-CartesianProduct-Lazy'; |
9
|
|
|
|
|
|
|
} |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# ABSTRACT: lazily calculate the tuples of a cartesian-product |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
4
|
use List::Util qw( reduce ); |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
123
|
|
14
|
1
|
|
|
1
|
|
4
|
use Scalar::Util qw( reftype ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
88
|
|
15
|
1
|
|
|
1
|
|
1009
|
use Data::Dumper; |
|
1
|
|
|
|
|
10539
|
|
|
1
|
|
|
|
|
80
|
|
16
|
1
|
|
|
1
|
|
10
|
use Carp; |
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
616
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new { |
19
|
5
|
|
|
5
|
1
|
1947
|
my $class = shift; |
20
|
5
|
|
|
|
|
12
|
my %opts = map { %$_ } grep { reftype $_ eq 'HASH' } @_; |
|
1
|
|
|
|
|
5
|
|
|
13
|
|
|
|
|
43
|
|
21
|
5
|
|
|
|
|
8
|
my @sets = grep { reftype $_ eq 'ARRAY' } @_; |
|
13
|
|
|
|
|
39
|
|
22
|
|
|
|
|
|
|
|
23
|
5
|
|
|
|
|
17
|
my $getsub = __make_getsub(\%opts, \@sets); |
24
|
|
|
|
|
|
|
|
25
|
5
|
|
|
|
|
36
|
return bless { %opts, sets => \@sets, getsub => $getsub }, $class; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub __make_getsub { |
29
|
5
|
|
|
5
|
|
7
|
my ($opts, $sets_ref) = @_; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# TODO: eval code to produce the sub so the code isn't duplicated |
32
|
|
|
|
|
|
|
|
33
|
5
|
100
|
|
|
|
16
|
if ($opts->{less_lazy}) { |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# pre-calculate some things, so we don't have to every time. |
36
|
1
|
|
|
|
|
3
|
my @sets = @$sets_ref; |
37
|
3
|
|
|
|
|
26
|
my @info = map { |
38
|
1
|
|
|
3
|
|
3
|
[ $_, (scalar @{$sets[$_]}), reduce { $a * @$b } 1, @sets[$_ + 1 .. $#sets] ]; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
11
|
|
39
|
|
|
|
|
|
|
} 0 .. $#sets; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
return sub { |
42
|
2
|
|
|
2
|
|
4
|
my ($n) = @_; |
43
|
|
|
|
|
|
|
|
44
|
6
|
|
|
|
|
572
|
my @tuple = map { |
45
|
2
|
|
|
|
|
5
|
my ($set_num, $set_size, $factor) = @$_; |
46
|
6
|
|
|
|
|
22
|
$sets[ $set_num ][ int( $n / $factor ) % $set_size ]; |
47
|
|
|
|
|
|
|
} @info; |
48
|
|
|
|
|
|
|
|
49
|
2
|
50
|
|
|
|
14
|
return wantarray ? @tuple : \@tuple; |
50
|
1
|
|
|
|
|
8
|
}; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
return sub { |
54
|
9
|
|
|
9
|
|
10
|
my ($n) = @_; |
55
|
|
|
|
|
|
|
|
56
|
9
|
|
|
|
|
9
|
my @tuple; |
57
|
|
|
|
|
|
|
|
58
|
9
|
|
|
|
|
17
|
my @sets = @$sets_ref; |
59
|
|
|
|
|
|
|
|
60
|
9
|
|
|
|
|
17
|
for my $set_num (0 .. $#sets) { |
61
|
20
|
|
|
|
|
40
|
my $set_size = @{ $sets[$set_num] }; |
|
20
|
|
|
|
|
33
|
|
62
|
20
|
|
|
|
|
97
|
my $factor = reduce { $a * @$b } 1, @sets[$set_num + 1 .. $#sets]; |
|
13
|
|
|
|
|
27
|
|
63
|
20
|
|
|
|
|
65
|
my $idx = int( $n / $factor ) % $set_size; |
64
|
|
|
|
|
|
|
|
65
|
20
|
|
|
|
|
51
|
push @tuple, $sets[$set_num][$idx]; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
9
|
50
|
|
|
|
50
|
return wantarray ? @tuple : \@tuple; |
69
|
4
|
|
|
|
|
35
|
}; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub get { |
74
|
11
|
|
|
11
|
1
|
1492
|
my $self = shift; |
75
|
11
|
50
|
|
|
|
28
|
croak "no value passed to get method\n" unless defined $_[0]; |
76
|
11
|
|
|
|
|
25
|
$self->{getsub}->(@_); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
#sub get_faster { my $self = shift; $self->{getsub}->(@_); } |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
{ |
83
|
1
|
|
|
1
|
|
6
|
no warnings 'once'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
199
|
|
84
|
25
|
50
|
|
25
|
1
|
55
|
sub count { return reduce { $a * @$b } 1, @{ shift->{sets} || [] } } |
|
10
|
|
|
10
|
|
74
|
|
|
10
|
|
|
|
|
67
|
|
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
3
|
|
|
3
|
1
|
989
|
sub last_idx { return shift->count - 1 } |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1 && q{a set in time saves nine}; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=pod |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head1 NAME |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Set::CartesianProduct::Lazy - lazily calculate the tuples of a cartesian-product |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 VERSION |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
version 0.002 |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 SYNOPSIS |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
my @a = qw( foo bar baz bah ); |
106
|
|
|
|
|
|
|
my @b = qw( wibble wobble weeble ); |
107
|
|
|
|
|
|
|
my @c = qw( nip nop ); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
my $cpl = Set::CartesianProduct::Lazy->new( \@a, \@b, \@c ); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my $tuple; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
$tuple = $cpl->get(0); # [ qw( foo wibble nip ) ] |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
$tuple = $cpl->get(21); # [ qw( bah wobble nop ) ] |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$tuple = $cpl->get(7); # [ qw( bar wobble nip ) ] |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
$cpl->count; # 24 |
120
|
|
|
|
|
|
|
$cpl->last_idx; # 23 |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 DESCRIPTION |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
If you have some number of arrays, say like this: |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
@a = qw( foo bar baz bah ); |
127
|
|
|
|
|
|
|
@b = qw( wibble wobble weeble ); |
128
|
|
|
|
|
|
|
@c = qw( nip nop ); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
And you want all the combinations of one element from each array, like this: |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
@cp = ( |
133
|
|
|
|
|
|
|
[qw( foo wibble nip )], |
134
|
|
|
|
|
|
|
[qw( foo wibble nop )], |
135
|
|
|
|
|
|
|
[qw( foo wobble nip )], |
136
|
|
|
|
|
|
|
[qw( foo wobble nop )], |
137
|
|
|
|
|
|
|
[qw( foo weeble nip )], |
138
|
|
|
|
|
|
|
# ... |
139
|
|
|
|
|
|
|
[qw( bah wobble nop )], |
140
|
|
|
|
|
|
|
[qw( bah weeble nip )], |
141
|
|
|
|
|
|
|
[qw( bah weeble nop )], |
142
|
|
|
|
|
|
|
) |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
What you want is a Cartesian Product (also called a Cross Product, but my |
145
|
|
|
|
|
|
|
mathy friends insist that Cartesian is correct) |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
Yes, there are already a lot of other modules on the CPAN that do this. |
148
|
|
|
|
|
|
|
I won't claim that this module does this calculation any better or faster, |
149
|
|
|
|
|
|
|
but it does do it I, as far as I can tell. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Nothing else seemed to offer a specific feature - I needed to pick random |
152
|
|
|
|
|
|
|
individual tuples from the Cartesian Product, I iterating over |
153
|
|
|
|
|
|
|
the whole set and I calculating any tuples until they were |
154
|
|
|
|
|
|
|
asked for. Bonus points for not making a copy of the original input sets. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
I needed the calculation to be lazy, and I needed random-access with O(1) |
157
|
|
|
|
|
|
|
(well, O(n) for the persnickety but n is so small it might as well be 1) |
158
|
|
|
|
|
|
|
retrieval time, even if that meant a slower implementation overall. And |
159
|
|
|
|
|
|
|
I didn't want to use RAM unnecessarily by creating copies of the original |
160
|
|
|
|
|
|
|
arrays, since the data I was working with was of a significant size. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 METHODS |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head2 new |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Construct a new object. Takes the following arguments: |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=over 4 |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=item * |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
options |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
A hashref of options that modify the way the object works. |
175
|
|
|
|
|
|
|
If you don't want to specify any options, simply omit this |
176
|
|
|
|
|
|
|
argument. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=over 4 |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=item less_lazy |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Makes the get method slightly faster, at the expense |
183
|
|
|
|
|
|
|
of not being able to account for any modifications made |
184
|
|
|
|
|
|
|
to the original input arrays, and using more memory. |
185
|
|
|
|
|
|
|
If you modify one of the arrays used to consruct the object, |
186
|
|
|
|
|
|
|
the results of all the other methods are B. |
187
|
|
|
|
|
|
|
You might get the wrong answer. You might trigger an |
188
|
|
|
|
|
|
|
exception, you might get mutations that give you super-powers |
189
|
|
|
|
|
|
|
at the expense of never being able to touch another human |
190
|
|
|
|
|
|
|
being without killing them. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=back |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item * |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sets |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
A list of arrayrefs from which to compute the cartesian product. |
199
|
|
|
|
|
|
|
You can list as many as you want. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=back |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
Some examples: |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
my $cpl = Set::CartesianProduct::Lazy->new(\@a, [qw(foo bar baz)], \@b); |
206
|
|
|
|
|
|
|
my $cpl = Set::CartesianProduct::Lazy->new( { less_lazy => 1 }, \@a, \@b, \@c); |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 get |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Return the tuple at the given "position" in the cartesian product. |
211
|
|
|
|
|
|
|
The positions, like array indices, are based at 0. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
If called in scalar context, an arrayref is returned. If called in list |
214
|
|
|
|
|
|
|
context, a list is returned. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
If you ask for a position that exceeds the bounds of the array defining the |
217
|
|
|
|
|
|
|
cartesian product the result will be... interesting. I won't make any |
218
|
|
|
|
|
|
|
guarantees, but if it's useful, let me know. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Examples: |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
my @tuple = $cpl->get(12); # list context |
223
|
|
|
|
|
|
|
my $tuple2 = $cpl->get( $cpl->count / 2 ); # scalar context |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
my $fail = $cpl->get( $cpl->count ); # probably equal to ->get(0) |
226
|
|
|
|
|
|
|
my $fail2 = $cpl->get( -1 ); # who knows |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 count |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Return the count of tuples that would be in the cartesian |
231
|
|
|
|
|
|
|
product if it had been generated. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Example: |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $count = $cpl->count; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head2 last_idx |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Return the index of the last tuple that would be in the cartesian |
240
|
|
|
|
|
|
|
product if it had been generated. This is just for conveniece |
241
|
|
|
|
|
|
|
so you don't have to write code like this: |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
for my $i ( 0 .. $cpl->count - 1 ) { ... } |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
And you can do this instead: |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
for my $i ( 0 .. $cpl->last_idx ) { ... } |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Which I feel is more readable. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head1 SUPPORT |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head2 Bugs / Feature Requests |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Please report any bugs or feature requests by email to C, or through |
258
|
|
|
|
|
|
|
the web interface at L. You will be automatically notified of any |
259
|
|
|
|
|
|
|
progress on the request by the system. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 Source Code |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
The code is open to the world, and available for you to hack on. Please feel free to browse it and play |
264
|
|
|
|
|
|
|
with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull |
265
|
|
|
|
|
|
|
from your repository :) |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
L |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
git clone https://github.com/Hercynium/Set-CartesianProduct-Lazy.git |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head1 AUTHOR |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Stephen R. Scaffidi |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
This software is copyright (c) 2012 by Stephen R. Scaffidi. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
280
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=cut |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
__END__ |