File Coverage

lib/Set/CartesianProduct/Lazy.pm
Criterion Covered Total %
statement 61 61 100.0
branch 6 10 60.0
condition n/a
subroutine 16 16 100.0
pod 4 4 100.0
total 87 91 95.6


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__