| 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__ |