File Coverage

blib/lib/Set/Intersection.pm
Criterion Covered Total %
statement 27 27 100.0
branch 8 8 100.0
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 40 40 100.0


line stmt bran cond sub pod time code
1             package Set::Intersection;
2            
3 4     4   133289 use warnings;
  4         10  
  4         153  
4 4     4   24 use strict;
  4         8  
  4         1707  
5            
6             =head1 NAME
7            
8             Set::Intersection - provides an API to get intersection (of set theory) of ARRAYs.
9            
10             =head1 VERSION
11            
12             Version 0.01
13            
14             =cut
15            
16             our $VERSION = '0.02';
17            
18            
19             =head1 SYNOPSIS
20            
21             use Set::Intersection;
22            
23             my @arr1 = qw/3 1 4 1 5 9/;
24             my @arr2 = qw/1 7 3 2 0 5/;
25             my @intersection = get_intersection(\@arr1, \@arr2);
26             # got (1, 3, 5) in @intersection
27            
28             =head1 EXPORT
29            
30             get_intersection
31            
32             =cut
33            
34             require Exporter;
35             our @ISA = qw/Exporter/;
36            
37             our @EXPORT = qw/get_intersection/;
38            
39             =head1 FUNCTIONS
40            
41             =head2 get_intersection [\%options,] [\@ARRAY[, \@ARRAY[, ...]]]
42            
43             Returns intersection set (as LIST) of all ARRAYs.
44            
45             =over 1
46            
47             =item The result LIST is uniqized and unordered.
48            
49             =item If no ARRAYs passed, the result LIST is empty.
50            
51             =item If only one ARRAY passed, the result LIST is same as the passed. (elements won't be uniqized nor order-changed)
52            
53             =item If you have undef in any LIST, you'll be warned.
54            
55             =back
56            
57             =over 1
58            
59             =item %options
60            
61             =over 2
62            
63             =item -preordered => BOOLEAN
64            
65             =over 3
66            
67             =item To reduce calculation time, get_intersection sorts ARRAYs
68             by their length before calculating intersections.
69            
70             =item This option tells that order of ARRAYs are well done,
71             and calculation of intersection will be based on left most ARRAY.
72            
73             =back
74            
75             =back
76            
77             =back
78            
79             =cut
80            
81             my %_default_opts = (
82             -preordered => 0,
83             );
84            
85             sub get_intersection
86             {
87 12     12 1 10377 my %opts;
88 12 100       53 if ( ref($_[0]) =~ m{^HASH} ) {
89 1         4 %opts = (%_default_opts, %{$_[0]});
  1         5  
90 1         3 shift;
91             }
92            
93 12         31 my @arrs = @_;
94 12 100       34 return () if !@arrs;
95 11 100       136 return @{$arrs[0]} if @arrs == 1;
  1         7  
96            
97 10 100       71 @arrs = sort { @$a <=> @$b } @arrs if !$opts{-preordered};
  17         41  
98            
99 10         16 my $head = shift @arrs;
100            
101 10         35 _intersection($head, @arrs);
102             }
103            
104             sub _intersection
105             {
106 10     10   23 my ($head, @left) = @_;
107            
108 10         23 my %h = map { $_ => undef } @$head;
  40         279  
109 10         28 for my $l ( @left ) {
110 15         25 %h = map { $_ => undef } grep { exists $h{$_} } @$l;
  27         194  
  79         277  
111             }
112 10         64 keys %h;
113             }
114            
115             =head1 SEE ALSO
116            
117             List::Compare, Set::Object
118            
119             =head1 AUTHOR
120            
121             turugina, C<< >>
122            
123             =head1 BUGS
124            
125             Please report any bugs or feature requests to C, or through
126             the web interface at L. I will be notified, and then you'll
127             automatically be notified of progress on your bug as I make changes.
128            
129            
130            
131            
132             =head1 SUPPORT
133            
134             You can find documentation for this module with the perldoc command.
135            
136             perldoc Set::Intersection
137            
138            
139             You can also look for information at:
140            
141             =over 4
142            
143             =item * RT: CPAN's request tracker
144            
145             L
146            
147             =item * AnnoCPAN: Annotated CPAN documentation
148            
149             L
150            
151             =item * CPAN Ratings
152            
153             L
154            
155             =item * Search CPAN
156            
157             L
158            
159             =back
160            
161            
162             =head1 ACKNOWLEDGEMENTS
163            
164            
165             =head1 COPYRIGHT & LICENSE
166            
167             Copyright 2009 turugina, all rights reserved.
168            
169             This program is free software; you can redistribute it and/or modify it
170             under the same terms as Perl itself.
171            
172            
173             =cut
174            
175             1; # End of Set::Intersection