File Coverage

blib/lib/List/Compare.pm
Criterion Covered Total %
statement 1093 1094 99.9
branch 256 256 100.0
condition 89 93 95.7
subroutine 163 163 100.0
pod 23 31 74.1
total 1624 1637 99.2


line stmt bran cond sub pod time code
1             package List::Compare;
2             $VERSION = '0.53';
3 34     34   667955 use strict;
  34         71  
  34         1583  
4             local $^W = 1;
5 34     34   161 use Carp;
  34         42  
  34         2797  
6 34         96921 use List::Compare::Base::_Auxiliary qw(
7             _validate_2_seenhashes
8             _chart_engine_regular
9 34     34   16825 );
  34         81  
10              
11             sub new {
12 212     212 1 53054 my $class = shift;
13 212         289 my (@args, $unsorted, $accelerated);
14 0         0 my ($argument_error_status, $nextarg, @testargs);
15 212 100 100     1181 if (@_ == 1 and (ref($_[0]) eq 'HASH')) {
16 89         107 my $argref = shift;
17 89         299 die "Need to pass references to 2 or more seen-hashes or \n to provide a 'lists' key within the single hash being passed by reference"
18 89 100       92 unless exists ${$argref}{'lists'};
19 88         292 die "Need to define 'lists' key properly: $!"
20 87         332 unless ( ${$argref}{'lists'}
21 88 100 100     108 and (ref(${$argref}{'lists'}) eq 'ARRAY') );
22 86         103 @args = @{${$argref}{'lists'}};
  86         81  
  86         197  
23 86 100       89 $unsorted = ${$argref}{'unsorted'} ? 1 : '';
  86         197  
24 86 100       91 $accelerated = ${$argref}{'accelerated'} ? 1 : '';
  86         215  
25             } else {
26 123         253 @args = @_;
27 123 100 100     611 $unsorted = ($args[0] eq '-u' or $args[0] eq '--unsorted')
28             ? shift(@args) : '';
29 123 100 100     576 $accelerated = shift(@args)
30             if ($args[0] eq '-a' or $args[0] eq '--accelerated');
31             }
32 209         252 $argument_error_status = 1;
33 209         608 @testargs = @args[1..$#args];
34 209 100 100     856 if (ref($args[0]) eq 'ARRAY' or ref($args[0]) eq 'HASH') {
35 195         465 while (defined ($nextarg = shift(@testargs))) {
36 339 100       1013 unless (ref($nextarg) eq ref($args[0])) {
37 16         24 $argument_error_status = 0;
38 16         28 last;
39             }
40             }
41             } else {
42 14         29 $argument_error_status = 0;
43             }
44 209 100       3610 croak "Must pass all array references or all hash references: $!"
45             unless $argument_error_status;
46              
47             # Compose the name of the class
48 179 100       467 if (@args > 2) {
    100          
49 43 100       86 if ($accelerated) {
50 22         46 $class .= '::Multiple::Accelerated';
51             } else {
52 21         46 $class .= '::Multiple';
53             }
54             } elsif (@args == 2) {
55 129 100       325 if ($accelerated) {
56 61         84 $class .= '::Accelerated';
57             }
58             } else {
59 7         703 croak "Must pass at least 2 references to \&new: $!";
60             }
61              
62             # do necessary calculations and store results in a hash
63             # take a reference to that hash
64 172         572 my $self = bless {}, $class;
65 172 100       639 my $dataref = $self->_init(($unsorted ? 1 : 0), @args);
66              
67             # initialize the object from the prepared values (Damian, p. 98)
68 162         981 %$self = %$dataref;
69 162         714 return $self;
70             }
71              
72             sub _init {
73 68     68   79 my $self = shift;
74 68         96 my ($unsortflag, $refL, $refR) = @_;
75 68         62 my (%data, @left, @right, %seenL, %seenR);
76 68 100       139 if (ref($refL) eq 'HASH') {
77 27         86 my ($seenLref, $seenRref) = _validate_2_seenhashes($refL, $refR);
78 23         27 foreach my $key (keys %{$seenLref}) {
  23         62  
79 116         207 for (my $j=1; $j <= ${$seenLref}{$key}; $j++) {
  255         423  
80 139         139 push(@left, $key);
81             }
82             }
83 23         31 foreach my $key (keys %{$seenRref}) {
  23         53  
84 105         94 for (my $j=1; $j <= ${$seenRref}{$key}; $j++) {
  228         351  
85 123         113 push(@right, $key);
86             }
87             }
88 23         30 %seenL = %{$seenLref};
  23         76  
89 23         27 %seenR = %{$seenRref};
  23         82  
90             } else {
91 41         77 foreach (@$refL) { $seenL{$_}++ }
  160         249  
92 41         70 foreach (@$refR) { $seenR{$_}++ }
  149         184  
93 41         85 @left = @$refL;
94 41         86 @right = @$refR;
95             }
96 64 100       282 my @bag = $unsortflag ? (@left, @right) : sort(@left, @right);
97 64         68 my (%intersection, %union, %Lonly, %Ronly, %LorRonly);
98 64         74 my $LsubsetR_status = my $RsubsetL_status = 1;
99 64         67 my $LequivalentR_status = 0;
100              
101 64         249 foreach (keys %seenL) {
102 252         230 $union{$_}++;
103 252 100       424 exists $seenR{$_} ? $intersection{$_}++ : $Lonly{$_}++;
104             }
105              
106 64         138 foreach (keys %seenR) {
107 235         196 $union{$_}++;
108 235 100       383 $Ronly{$_}++ unless (exists $intersection{$_});
109             }
110              
111 64         212 $LorRonly{$_}++ foreach ( (keys %Lonly), (keys %Ronly) );
112              
113 64 100       141 $LequivalentR_status = 1 if ( (keys %LorRonly) == 0);
114              
115 64         86 foreach (@left) {
116 169 100       264 if (! exists $seenR{$_}) {
117 39         60 $LsubsetR_status = 0;
118 39         89 last;
119             }
120             }
121 64         85 foreach (@right) {
122 238 100       364 if (! exists $seenL{$_}) {
123 32         60 $RsubsetL_status = 0;
124 32         33 last;
125             }
126             }
127              
128 64         113 $data{'seenL'} = \%seenL;
129 64         91 $data{'seenR'} = \%seenR;
130 64 100       234 $data{'intersection'} = $unsortflag ? [ keys %intersection ]
131             : [ sort keys %intersection ];
132 64 100       244 $data{'union'} = $unsortflag ? [ keys %union ]
133             : [ sort keys %union ];
134 64 100       178 $data{'unique'} = $unsortflag ? [ keys %Lonly ]
135             : [ sort keys %Lonly ];
136 64 100       160 $data{'complement'} = $unsortflag ? [ keys %Ronly ]
137             : [ sort keys %Ronly ];
138 64 100       226 $data{'symmetric_difference'} = $unsortflag ? [ keys %LorRonly ]
139             : [ sort keys %LorRonly ];
140 64         120 $data{'LsubsetR_status'} = $LsubsetR_status;
141 64         85 $data{'RsubsetL_status'} = $RsubsetL_status;
142 64         86 $data{'LequivalentR_status'} = $LequivalentR_status;
143 64 100       141 $data{'LdisjointR_status'} = keys %intersection == 0 ? 1 : 0;
144 64         83 $data{'bag'} = \@bag;
145 64         253 return \%data;
146             }
147              
148             sub get_intersection {
149 26     26 1 6471 return @{ get_intersection_ref(shift) };
  26         76  
150             }
151              
152             sub get_intersection_ref {
153 52     52 0 4035 my $class = shift;
154 52         313 my %data = %$class;
155 52         341 return $data{'intersection'};
156             }
157              
158             sub get_union {
159 8     8 1 5335 return @{ get_union_ref(shift) };
  8         28  
160             }
161              
162             sub get_union_ref {
163 16     16 0 4384 my $class = shift;
164 16         107 my %data = %$class;
165 16         75 return $data{'union'};
166             }
167              
168             sub get_shared {
169 8     8 1 14081 my $class = shift;
170 8         44 my $method = (caller(0))[3];
171 8         1364 carp "When comparing only 2 lists, $method defaults to \n ", 'get_intersection()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
172 8         647 get_intersection($class);
173             }
174              
175             sub get_shared_ref {
176 8     8 0 15636 my $class = shift;
177 8         41 my $method = (caller(0))[3];
178 8         727 carp "When comparing only 2 lists, $method defaults to \n ", 'get_intersection_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
179 8         453 get_intersection_ref($class);
180             }
181              
182             sub get_unique {
183 24     24 1 18051 return @{ get_unique_ref(shift) };
  24         59  
184             }
185              
186             sub get_unique_ref {
187 48     48 0 12860 my $class = shift;
188 48         288 my %data = %$class;
189 48         195 return $data{'unique'};
190             }
191              
192             sub get_unique_all {
193 8     8 1 4377 my $class = shift;
194 8         103 my %data = %$class;
195 8         43 return [ $data{'unique'}, $data{'complement'} ];
196             }
197              
198             *get_Lonly = \&get_unique;
199             *get_Aonly = \&get_unique;
200             *get_Lonly_ref = \&get_unique_ref;
201             *get_Aonly_ref = \&get_unique_ref;
202              
203             sub get_complement {
204 24     24 1 14108 return @{ get_complement_ref(shift) };
  24         61  
205             }
206              
207             sub get_complement_ref {
208 48     48 0 13064 my $class = shift;
209 48         297 my %data = %$class;
210 48         200 return $data{'complement'};
211             }
212              
213             sub get_complement_all {
214 8     8 1 4336 my $class = shift;
215 8         70 my %data = %$class;
216 8         42 return [ $data{'complement'}, $data{'unique'} ];
217             }
218              
219             *get_Ronly = \&get_complement;
220             *get_Bonly = \&get_complement;
221             *get_Ronly_ref = \&get_complement_ref;
222             *get_Bonly_ref = \&get_complement_ref;
223              
224             sub get_symmetric_difference {
225 40     40 1 18315 return @{ get_symmetric_difference_ref(shift) };
  40         87  
226             }
227              
228             sub get_symmetric_difference_ref {
229 80     80 0 18349 my $class = shift;
230 80         512 my %data = %$class;
231 80         382 return $data{'symmetric_difference'};
232             }
233              
234             *get_symdiff = \&get_symmetric_difference;
235             *get_LorRonly = \&get_symmetric_difference;
236             *get_AorBonly = \&get_symmetric_difference;
237             *get_symdiff_ref = \&get_symmetric_difference_ref;
238             *get_LorRonly_ref = \&get_symmetric_difference_ref;
239             *get_AorBonly_ref = \&get_symmetric_difference_ref;
240              
241             sub get_nonintersection {
242 8     8 1 12700 my $class = shift;
243 8         59 my $method = (caller(0))[3];
244 8         1370 carp "When comparing only 2 lists, $method defaults to \n ", 'get_symmetric_difference()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
245 8         580 get_symmetric_difference($class);
246             }
247              
248             sub get_nonintersection_ref {
249 8     8 1 15777 my $class = shift;
250 8         51 my $method = (caller(0))[3];
251 8         822 carp "When comparing only 2 lists, $method defaults to \n ", 'get_symmetric_difference_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
252 8         422 get_symmetric_difference_ref($class);
253             }
254              
255             sub is_LsubsetR {
256 48     48 1 11133 my $class = shift;
257 48         289 my %data = %$class;
258 48         168 return $data{'LsubsetR_status'};
259             }
260              
261             *is_AsubsetB = \&is_LsubsetR;
262              
263             sub is_RsubsetL {
264 48     48 0 8660 my $class = shift;
265 48         255 my %data = %$class;
266 48         156 return $data{'RsubsetL_status'};
267             }
268              
269             *is_BsubsetA = \&is_RsubsetL;
270              
271             sub is_LequivalentR {
272 48     48 1 9639 my $class = shift;
273 48         294 my %data = %$class;
274 48         169 return $data{'LequivalentR_status'};
275             }
276              
277             *is_LeqvlntR = \&is_LequivalentR;
278              
279             sub is_LdisjointR {
280 34     34 1 5340 my $class = shift;
281 34         227 my %data = %$class;
282 34         134 return $data{'LdisjointR_status'};
283             }
284              
285             sub print_subset_chart {
286 8     8 1 9161 my $class = shift;
287 8         80 my %data = %$class;
288 8         34 my @subset_array = ($data{'LsubsetR_status'}, $data{'RsubsetL_status'});
289 8         15 my $title = 'Subset';
290 8         51 _chart_engine_regular(\@subset_array, $title);
291             }
292              
293             sub print_equivalence_chart {
294 8     8 1 12915 my $class = shift;
295 8         71 my %data = %$class;
296 8         33 my @equivalent_array = ($data{'LequivalentR_status'},
297             $data{'LequivalentR_status'});
298 8         15 my $title = 'Equivalence';
299 8         34 _chart_engine_regular(\@equivalent_array, $title);
300             }
301              
302             sub is_member_which {
303 92     92 1 8532 return @{ is_member_which_ref(@_) };
  92         133  
304             }
305              
306             sub is_member_which_ref {
307 185     185 1 5059 my $class = shift;
308 185 100 100     1831 croak "Method call requires exactly 1 argument (no references): $!"
309             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
310 176         633 my %data = %$class;
311 176         204 my ($arg, @found);
312 176         154 $arg = shift;
313 176 100       133 if (exists ${$data{'seenL'}}{$arg}) { push @found, 0; }
  176         322  
  112         140  
314 176 100       130 if (exists ${$data{'seenR'}}{$arg}) { push @found, 1; }
  176         288  
  112         107  
315 176 100 66     125 if ( (! exists ${$data{'seenL'}}{$arg}) &&
  176         314  
  64         125  
316             (! exists ${$data{'seenR'}}{$arg}) )
317 48         80 { @found = (); }
318 176         469 return \@found;
319             }
320              
321             sub are_members_which {
322 13     13 1 4309 my $class = shift;
323 13 100 100     525 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
324             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
325 8         58 my %data = %$class;
326 8         17 my (@args, %found);
327 8         15 @args = @{$_[0]};
  8         28  
328 8         43 for (my $i=0; $i<=$#args; $i++) {
329 88 100       72 if (exists ${$data{'seenL'}}{$args[$i]}) { push @{$found{$args[$i]}}, 0; }
  88         164  
  56         43  
  56         98  
330 88 100       71 if (exists ${$data{'seenR'}}{$args[$i]}) { push @{$found{$args[$i]}}, 1; }
  88         151  
  56         41  
  56         88  
331 88 100 66     70 if ( (! exists ${$data{'seenL'}}{$args[$i]}) &&
  88         260  
  32         67  
332             (! exists ${$data{'seenR'}}{$args[$i]}) )
333 24         24 { @{$found{$args[$i]}} = (); }
  24         68  
334             }
335 8         37 return \%found;
336             }
337              
338             sub is_member_any {
339 93     93 1 4645 my $class = shift;
340 93 100 100     708 croak "Method call requires exactly 1 argument (no references): $!"
341             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
342 88         468 my %data = %$class;
343 88         120 my $arg = shift;
344 88 100 100     413 ( defined $data{'seenL'}{$arg} ) ||
345             ( defined $data{'seenR'}{$arg} ) ? return 1 : return 0;
346             }
347              
348             sub are_members_any {
349 13     13 1 4178 my $class = shift;
350 13 100 100     502 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
351             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
352 8         63 my %data = %$class;
353 8         18 my (@args, %present);
354 8         22 @args = @{$_[0]};
  8         35  
355 8         41 for (my $i=0; $i<=$#args; $i++) {
356 88 100 100     368 $present{$args[$i]} = ( defined $data{'seenL'}{$args[$i]} ) ||
357             ( defined $data{'seenR'}{$args[$i]} ) ? 1 : 0;
358             }
359 8         219 return \%present;
360             }
361              
362             sub get_bag {
363 8     8 1 8976 return @{ get_bag_ref(shift) };
  8         36  
364             }
365              
366             sub get_bag_ref {
367 16     16 0 4562 my $class = shift;
368 16         111 my %data = %$class;
369 16         96 return $data{'bag'};
370             }
371              
372             sub get_version {
373 8     8 1 2745 return $List::Compare::VERSION;
374             }
375              
376             1;
377              
378             ################################################################################
379              
380             package List::Compare::Accelerated;
381 34     34   352 use Carp;
  34         56  
  34         2632  
382 34         106306 use List::Compare::Base::_Auxiliary qw(
383             _argument_checker_0
384             _chart_engine_regular
385             _calc_seen
386             _equiv_engine
387 34     34   183 );
  34         48  
388              
389             sub _init {
390 61     61   73 my $self = shift;
391 61         83 my ($unsortflag, $refL, $refR) = @_;
392 61         102 my %data = ();
393 61         181 ($data{'L'}, $data{'R'}) = _argument_checker_0($refL, $refR);
394 57 100       124 $data{'unsort'} = $unsortflag ? 1 : 0;
395 57         132 return \%data;
396             }
397              
398             sub get_intersection {
399 14     14   13605 return @{ get_intersection_ref(shift) };
  14         50  
400             }
401              
402             sub get_intersection_ref {
403 28     28   4860 my $class = shift;
404 28         143 my %data = %$class;
405 16         45 $data{'unsort'}
406             ? return _intersection_engine($data{'L'}, $data{'R'})
407 28 100       112 : return [ sort @{_intersection_engine($data{'L'}, $data{'R'})} ];
408             }
409              
410             sub get_union {
411 8     8   3065 return @{ get_union_ref(shift) };
  8         27  
412             }
413              
414             sub get_union_ref {
415 32     32   5407 my $class = shift;
416 32         137 my %data = %$class;
417 16         92 $data{'unsort'}
418             ? return _union_engine($data{'L'}, $data{'R'})
419 32 100       171 : return [ sort @{_union_engine($data{'L'}, $data{'R'})} ];
420             }
421              
422             sub get_shared {
423 8     8   27434 return @{ get_shared_ref(shift) };
  8         42  
424             }
425              
426             sub get_shared_ref {
427 16     16   18752 my $class = shift;
428 16         89 my $method = (caller(0))[3];
429 16         143 $method =~ s/.*::(\w*)$/$1/;
430 16         2515 carp "When comparing only 2 lists, \&$method defaults to \n \&get_union_ref. Though the results returned are valid, \n please consider re-coding with that method: $!";
431 16         1270 &get_union_ref($class);
432             }
433              
434             sub get_unique {
435 24     24   14863 return @{ get_unique_ref(shift) };
  24         58  
436             }
437              
438             sub get_unique_ref {
439 64     64   14858 my $class = shift;
440 64         230 my %data = %$class;
441 32         69 $data{'unsort'}
442             ? return _unique_engine($data{'L'}, $data{'R'})
443 64 100       209 : return [ sort @{_unique_engine($data{'L'}, $data{'R'})} ];
444             }
445              
446             sub get_unique_all {
447 8     8   5138 my $class = shift;
448 8         24 return [ get_unique_ref($class), get_complement_ref($class) ];
449             }
450              
451             *get_Lonly = \&get_unique;
452             *get_Aonly = \&get_unique;
453             *get_Lonly_ref = \&get_unique_ref;
454             *get_Aonly_ref = \&get_unique_ref;
455              
456             sub get_complement {
457 24     24   15808 return @{ get_complement_ref(shift) };
  24         57  
458             }
459              
460             sub get_complement_ref {
461 64     64   13867 my $class = shift;
462 64         219 my %data = %$class;
463 32         61 $data{'unsort'}
464             ? return _complement_engine($data{'L'}, $data{'R'})
465 64 100       197 : return [ sort @{_complement_engine($data{'L'}, $data{'R'})} ];
466             }
467              
468             sub get_complement_all {
469 8     8   4593 my $class = shift;
470 8         27 return [ get_complement_ref($class), get_unique_ref($class) ];
471             }
472              
473             *get_Ronly = \&get_complement;
474             *get_Bonly = \&get_complement;
475             *get_Ronly_ref = \&get_complement_ref;
476             *get_Bonly_ref = \&get_complement_ref;
477              
478             sub get_symmetric_difference {
479 32     32   19101 return @{ get_symmetric_difference_ref(shift) };
  32         72  
480             }
481              
482             sub get_symmetric_difference_ref {
483 80     80   18239 my $class = shift;
484 80         284 my %data = %$class;
485 40         83 $data{'unsort'}
486             ? return _symmetric_difference_engine($data{'L'}, $data{'R'})
487 80 100       326 : return [ sort @{_symmetric_difference_engine($data{'L'}, $data{'R'})} ];
488             }
489              
490             *get_symdiff = \&get_symmetric_difference;
491             *get_LorRonly = \&get_symmetric_difference;
492             *get_AorBonly = \&get_symmetric_difference;
493             *get_symdiff_ref = \&get_symmetric_difference_ref;
494             *get_LorRonly_ref = \&get_symmetric_difference_ref;
495             *get_AorBonly_ref = \&get_symmetric_difference_ref;
496              
497             sub get_nonintersection {
498 8     8   12593 return @{ get_nonintersection_ref(shift) };
  8         37  
499             }
500              
501             sub get_nonintersection_ref {
502 16     16   16691 my $class = shift;
503 16         84 my $method = (caller(0))[3];
504 16         154 $method =~ s/.*::(\w*)$/$1/;
505 16         1989 carp "When comparing only 2 lists, \&$method defaults to \n \&get_symmetric_difference_ref. Though the results returned are valid, \n please consider re-coding with that method: $!";
506 16         1054 &get_symmetric_difference_ref($class);
507             }
508              
509             sub is_LsubsetR {
510 38     38   11597 my $class = shift;
511 38         145 my %data = %$class;
512 38         138 return _is_LsubsetR_engine($data{'L'}, $data{'R'});
513             }
514              
515             *is_AsubsetB = \&is_LsubsetR;
516              
517             sub is_RsubsetL {
518 38     38   8870 my $class = shift;
519 38         141 my %data = %$class;
520 38         113 return _is_RsubsetL_engine($data{'L'}, $data{'R'});
521             }
522              
523             *is_BsubsetA = \&is_RsubsetL;
524              
525             sub is_LequivalentR {
526 48     48   11931 my $class = shift;
527 48         206 my %data = %$class;
528 48         137 return _is_LequivalentR_engine($data{'L'}, $data{'R'});
529             }
530              
531             *is_LeqvlntR = \&is_LequivalentR;
532              
533             sub is_LdisjointR {
534 30     30   5811 my $class = shift;
535 30         117 my %data = %$class;
536 30         102 return _is_LdisjointR_engine($data{'L'}, $data{'R'});
537             }
538              
539             sub print_subset_chart {
540 8     8   8896 my $class = shift;
541 8         36 my %data = %$class;
542 8         38 _print_subset_chart_engine($data{'L'}, $data{'R'});
543             }
544              
545             sub print_equivalence_chart {
546 8     8   14043 my $class = shift;
547 8         42 my %data = %$class;
548 8         36 _print_equivalence_chart_engine($data{'L'}, $data{'R'});
549             }
550              
551             sub is_member_which {
552 92     92   9052 return @{ is_member_which_ref(@_) };
  92         137  
553             }
554              
555             sub is_member_which_ref {
556 185     185   5438 my $class = shift;
557 185 100 100     1605 croak "Method call requires exactly 1 argument (no references): $!"
558             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
559 176         438 my %data = %$class;
560 176         326 return _is_member_which_engine($data{'L'}, $data{'R'}, shift);
561             }
562              
563             sub are_members_which {
564 13     13   4269 my $class = shift;
565 13 100 100     503 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
566             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
567 8         36 my %data = %$class;
568 8         16 my (@args);
569 8         15 @args = @{$_[0]};
  8         46  
570 8         37 return _are_members_which_engine($data{'L'}, $data{'R'}, \@args);
571             }
572              
573             sub is_member_any {
574 93     93   4715 my $class = shift;
575 93 100 100     719 croak "Method call requires exactly 1 argument (no references): $!"
576             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
577 88         256 my %data = %$class;
578 88         149 return _is_member_any_engine($data{'L'}, $data{'R'}, shift);
579             }
580              
581             sub are_members_any {
582 13     13   3961 my $class = shift;
583 13 100 100     473 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
584             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
585 8         34 my %data = %$class;
586 8         78 my (@args);
587 8         12 @args = @{$_[0]};
  8         28  
588 8         38 return _are_members_any_engine($data{'L'}, $data{'R'}, \@args);
589             }
590              
591             sub get_bag {
592 8     8   9582 return @{ get_bag_ref(shift) };
  8         31  
593             }
594              
595             sub get_bag_ref {
596 16     16   5050 my $class = shift;
597 16         65 my %data = %$class;
598 16 100       73 if (ref($data{'L'}) eq 'ARRAY') {
599 4         9 $data{'unsort'} ? return [ @{$data{'L'}}, @{$data{'R'}} ]
  4         33  
  4         6  
600 8 100       29 : return [ sort(@{$data{'L'}}, @{$data{'R'}}) ];
  4         37  
601             } else {
602 8         9 my (@left, @right);
603 8         10 foreach my $key (keys %{$data{'L'}}) {
  8         23  
604 56         46 for (my $j=1; $j <= ${$data{'L'}}{$key}; $j++) {
  120         206  
605 64         74 push(@left, $key);
606             }
607             }
608 8         15 foreach my $key (keys %{$data{'R'}}) {
  8         19  
609 56         49 for (my $j=1; $j <= ${$data{'R'}}{$key}; $j++) {
  120         195  
610 64         66 push(@right, $key);
611             }
612             }
613 8 100       77 $data{'unsort'} ? return [ @left, @right ]
614             : return [ sort(@left, @right) ];
615             }
616             }
617              
618             sub get_version {
619 8     8   2914 return $List::Compare::VERSION;
620             }
621              
622             sub _intersection_engine {
623 28     28   39 my ($l, $r) = @_;
624 28         82 my ($hrefL, $hrefR) = _calc_seen($l, $r);
625 28         49 my %intersection = ();
626 28         35 foreach (keys %{$hrefL}) {
  28         168  
627 160 100       124 $intersection{$_}++ if (exists ${$hrefR}{$_});
  160         432  
628             }
629 28         242 return [ keys %intersection ];
630             }
631              
632             sub _union_engine {
633 32     32   79 my ($l, $r) = @_;
634 32         107 my ($hrefL, $hrefR) = _calc_seen($l, $r);
635 32         60 my %union = ();
636 32         39 $union{$_}++ foreach ( (keys %{$hrefL}), (keys %{$hrefR}) );
  32         88  
  32         388  
637 32         417 return [ keys %union ];
638             }
639              
640             sub _unique_engine {
641 64     64   150 my ($l, $r) = @_;
642 64         151 my ($hrefL, $hrefR) = _calc_seen($l, $r);
643 64         80 my (%Lonly);
644 64         71 foreach (keys %{$hrefL}) {
  64         200  
645 448 100       327 $Lonly{$_}++ unless exists ${$hrefR}{$_};
  448         932  
646             }
647 64         430 return [ keys %Lonly ];
648             }
649              
650             sub _complement_engine {
651 64     64   91 my ($l, $r) = @_;
652 64         146 my ($hrefL, $hrefR) = _calc_seen($l, $r);
653 64         68 my (%Ronly);
654 64         61 foreach (keys %{$hrefR}) {
  64         209  
655 448 100       320 $Ronly{$_}++ unless (exists ${$hrefL}{$_});
  448         903  
656             }
657 64         401 return [ keys %Ronly ];
658             }
659              
660             sub _symmetric_difference_engine {
661 80     80   88 my ($l, $r) = @_;
662 80         198 my ($hrefL, $hrefR) = _calc_seen($l, $r);
663 80         86 my (%LorRonly);
664 80         76 foreach (keys %{$hrefL}) {
  80         240  
665 560 100       392 $LorRonly{$_}++ unless (exists ${$hrefR}{$_});
  560         1095  
666             }
667 80         115 foreach (keys %{$hrefR}) {
  80         197  
668 560 100       403 $LorRonly{$_}++ unless (exists ${$hrefL}{$_});
  560         956  
669             }
670 80         732 return [ keys %LorRonly ];
671             }
672              
673             sub _is_LsubsetR_engine {
674 38     38   50 my ($l, $r) = @_;
675 38         114 my ($hrefL, $hrefR) = _calc_seen($l, $r);
676 38         52 my $LsubsetR_status = 1;
677 38         39 foreach (keys %{$hrefL}) {
  38         119  
678 109 100       91 if (! exists ${$hrefR}{$_}) {
  109         280  
679 32         34 $LsubsetR_status = 0;
680 32         63 last;
681             }
682             }
683 38         147 return $LsubsetR_status;
684             }
685              
686             sub _is_RsubsetL_engine {
687 38     38   47 my ($l, $r) = @_;
688 38         90 my ($hrefL, $hrefR) = _calc_seen($l, $r);
689 38         50 my $RsubsetL_status = 1;
690 38         47 foreach (keys %{$hrefR}) {
  38         112  
691 143 100       111 if (! exists ${$hrefL}{$_}) {
  143         267  
692 22         26 $RsubsetL_status = 0;
693 22         29 last;
694             }
695             }
696 38         150 return $RsubsetL_status;
697             }
698              
699             sub _is_LequivalentR_engine {
700 48     48   78 my ($l, $r) = @_;
701 48         116 my ($hrefL, $hrefR) = _calc_seen($l, $r);
702 48         123 return _equiv_engine($hrefL, $hrefR);
703             }
704              
705             sub _is_LdisjointR_engine {
706 30     30   44 my ($l, $r) = @_;
707 30         80 my ($hrefL, $hrefR) = _calc_seen($l, $r);
708 30         55 my %intersection = ();
709 30         37 foreach (keys %{$hrefL}) {
  30         114  
710 152 100       115 $intersection{$_}++ if (exists ${$hrefR}{$_});
  152         478  
711             }
712 30 100       183 keys %intersection == 0 ? 1 : 0;
713             }
714              
715             sub _print_subset_chart_engine {
716 8     8   17 my ($l, $r) = @_;
717 8         25 my ($hrefL, $hrefR) = _calc_seen($l, $r);
718 8         25 my $LsubsetR_status = my $RsubsetL_status = 1;
719 8         9 foreach (keys %{$hrefL}) {
  8         32  
720 32 100       37 if (! exists ${$hrefR}{$_}) {
  32         77  
721 8         13 $LsubsetR_status = 0;
722 8         19 last;
723             }
724             }
725 8         14 foreach (keys %{$hrefR}) {
  8         33  
726 29 100       23 if (! exists ${$hrefL}{$_}) {
  29         68  
727 8         11 $RsubsetL_status = 0;
728 8         12 last;
729             }
730             }
731 8         20 my @subset_array = ($LsubsetR_status, $RsubsetL_status);
732 8         17 my $title = 'Subset';
733 8         38 _chart_engine_regular(\@subset_array, $title);
734             }
735              
736             sub _print_equivalence_chart_engine {
737 8     8   15 my ($l, $r) = @_;
738 8         32 my ($hrefL, $hrefR) = _calc_seen($l, $r);
739 8         63 my $LequivalentR_status = _equiv_engine($hrefL, $hrefR);
740 8         22 my @equivalent_array = ($LequivalentR_status, $LequivalentR_status);
741 8         16 my $title = 'Equivalence';
742 8         29 _chart_engine_regular(\@equivalent_array, $title);
743             }
744              
745             sub _is_member_which_engine {
746 176     176   178 my ($l, $r, $arg) = @_;
747 176         309 my ($hrefL, $hrefR) = _calc_seen($l, $r);
748 176         156 my (@found);
749 176 100       141 if (exists ${$hrefL}{$arg}) { push @found, 0; }
  176         322  
  112         143  
750 176 100       145 if (exists ${$hrefR}{$arg}) { push @found, 1; }
  176         279  
  112         106  
751 176 100 66     136 if ( (! exists ${$hrefL}{$arg}) &&
  176         321  
  64         110  
752             (! exists ${$hrefR}{$arg}) )
753 48         57 { @found = (); }
754 176         581 return \@found;
755             }
756              
757             sub _are_members_which_engine {
758 8     8   17 my ($l, $r, $arg) = @_;
759 8         69 my ($hrefL, $hrefR) = _calc_seen($l, $r);
760 8         12 my @args = @{$arg};
  8         44  
761 8         17 my (%found);
762 8         106 for (my $i=0; $i<=$#args; $i++) {
763 88 100       66 if (exists ${$hrefL}{$args[$i]}) { push @{$found{$args[$i]}}, 0; }
  88         164  
  56         44  
  56         99  
764 88 100       131 if (exists ${$hrefR}{$args[$i]}) { push @{$found{$args[$i]}}, 1; }
  88         154  
  56         40  
  56         137  
765 88 100 66     70 if ( (! exists ${$hrefL}{$args[$i]}) &&
  88         271  
  32         68  
766             (! exists ${$hrefR}{$args[$i]}) )
767 24         22 { @{$found{$args[$i]}} = (); }
  24         97  
768             }
769 8         52 return \%found;
770             }
771              
772             sub _is_member_any_engine {
773 88     88   98 my ($l, $r, $arg) = @_;
774 88         151 my ($hrefL, $hrefR) = _calc_seen($l, $r);
775             ( defined ${$hrefL}{$arg} ) ||
776 88 100 100     73 ( defined ${$hrefR}{$arg} ) ? return 1 : return 0;
777             }
778              
779             sub _are_members_any_engine {
780 8     8   12 my ($l, $r, $arg) = @_;
781 8         147 my ($hrefL, $hrefR) = _calc_seen($l, $r);
782 8         13 my @args = @{$arg};
  8         36  
783 8         12 my (%present);
784 8         33 for (my $i=0; $i<=$#args; $i++) {
785             $present{$args[$i]} = ( defined ${$hrefL}{$args[$i]} ) ||
786 88 100 100     65 ( defined ${$hrefR}{$args[$i]} ) ? 1 : 0;
787             }
788 8         38 return \%present;
789             }
790              
791             1;
792              
793             ################################################################################
794              
795             package List::Compare::Multiple;
796 34     34   290 use Carp;
  34         47  
  34         2960  
797 34         126130 use List::Compare::Base::_Auxiliary qw(
798             _validate_seen_hash
799             _index_message1
800             _index_message2
801             _chart_engine_multiple
802 34     34   183 );
  34         43  
803              
804             sub _init {
805 21     21   34 my $self = shift;
806 21         30 my $unsortflag = shift;
807 21         58 my @listrefs = @_;
808 21         35 my (@arrayrefs);
809 21         55 my $maxindex = $#listrefs;
810 21 100       66 if (ref($listrefs[0]) eq 'ARRAY') {
811 10         25 @arrayrefs = @listrefs;
812             } else {
813 11         48 _validate_seen_hash(@listrefs);
814 9         20 foreach my $href (@listrefs) {
815 49         40 my (@temp);
816 49         39 foreach my $key (keys %{$href}) {
  49         77  
817 255         192 for (my $j=1; $j <= ${$href}{$key}; $j++) {
  555         927  
818 300         294 push(@temp, $key);
819             }
820             }
821 49         75 push(@arrayrefs, \@temp);
822             }
823             }
824              
825 19         36 my @bag = ();
826 19         37 foreach my $aref (@arrayrefs) {
827 101         406 push @bag, $_ foreach @$aref;
828             }
829 19 100       141 @bag = sort(@bag) unless $unsortflag;
830              
831 19         23 my (@intersection, @union);
832             # will hold overall intersection/union
833 19         31 my @nonintersection = ();
834             # will hold all items except those found in each source list
835             # @intersection + @nonintersection = @union
836 19         88 my @shared = ();
837             # will hold all items found in at least 2 lists
838 19         28 my @symmetric_difference = ();
839             # will hold each item found in only one list regardless of list;
840             # equivalent to @union minus all items found in the lists
841             # underlying %xintersection
842 19         33 my (%intersection, %union);
843             # will be used to generate @intersection & @union
844 19         31 my %seen = ();
845             # will be hash of hashes, holding seen-hashes corresponding to
846             # the source lists
847 19         29 my %xintersection = ();
848             # will be hash of hashes, holding seen-hashes corresponding to
849             # the lists containing the intersections of each permutation of
850             # the source lists
851 19         29 my %shared = ();
852             # will be used to generate @shared
853 19         31 my @xunique = ();
854             # will be array of arrays, holding the items that are unique to
855             # the list whose index number is passed as an argument
856 19         23 my @xcomplement = ();
857             # will be array of arrays, holding the items that are found in
858             # any list other than the list whose index number is passed
859             # as an argument
860 19         28 my @xdisjoint = ();
861             # will be an array of arrays, holding an indicator as to whether
862             # any pair of lists are disjoint, i.e., have no intersection
863              
864             # Calculate overall union and take steps needed to calculate overall
865             # intersection, unique, difference, etc.
866 19         71 for (my $i = 0; $i <= $#arrayrefs; $i++) {
867 101         196 my %seenthis = ();
868 101         79 foreach (@{$arrayrefs[$i]}) {
  101         148  
869 606         541 $seenthis{$_}++;
870 606         579 $union{$_}++;
871             }
872 101         228 $seen{$i} = \%seenthis;
873 101         238 for (my $j = $i+1; $j <=$#arrayrefs; $j++) {
874 223         167 my (%seenthat, %seenintersect);
875 223         236 my $ilabel = $i . '_' . $j;
876 223         152 $seenthat{$_}++ foreach (@{$arrayrefs[$j]});
  223         724  
877 223         413 foreach (keys %seenthat) {
878 938 100       1547 $seenintersect{$_}++ if (exists $seenthis{$_});
879             }
880 223         824 $xintersection{$ilabel} = \%seenintersect;
881             }
882             }
883 19 100       132 @union = $unsortflag ? keys %union : sort(keys %union);
884              
885             # At this point we now have %seen, @union and %xintersection available
886             # for use in other calculations.
887              
888             # Calculate overall intersection
889             # Inputs: %xintersection
890 19         81 my @xkeys = keys %xintersection;
891 19         37 %intersection = %{$xintersection{$xkeys[0]}};
  19         63  
892 19         63 for (my $m = 1; $m <= $#xkeys; $m++) {
893 204         155 my %compare = %{$xintersection{$xkeys[$m]}};
  204         498  
894 204         222 my %result = ();
895 204         266 foreach (keys %compare) {
896 553 100       901 $result{$_}++ if (exists $intersection{$_});
897             }
898 204         644 %intersection = %result;
899             }
900 19 100       71 @intersection = $unsortflag ? keys %intersection : sort(keys %intersection);
901              
902             # Calculate nonintersection
903             # Inputs: @union %intersection
904 19         33 foreach (@union) {
905 207 100       392 push(@nonintersection, $_) unless (exists $intersection{$_});
906             }
907              
908             # Calculate @xunique and @xdisjoint
909             # Inputs: @arrayrefs %seen %xintersection
910 19         65 for (my $i = 0; $i <= $#arrayrefs; $i++) {
911 101         85 my %seenthis = %{$seen{$i}};
  101         353  
912 101         116 my (@uniquethis, %deductions, %alldeductions);
913             # Get those elements of %xintersection which we'll need
914             # to subtract from %seenthis
915 101         312 foreach (keys %xintersection) {
916 1229         1673 my ($left, $right) = split /_/, $_;
917 1229 100 100     3510 if ($left == $i || $right == $i) {
918 446         492 $deductions{$_} = $xintersection{$_};
919             }
920 1229         2600 $xdisjoint[$left][$right] = $xdisjoint[$right][$left] =
921 1229 100       844 ! (keys %{$xintersection{$_}}) ? 1 : 0;
922             }
923 101         230 foreach my $ded (keys %deductions) {
924 446         368 foreach (keys %{$deductions{$ded}}) {
  446         702  
925 1196         1330 $alldeductions{$_}++;
926             }
927             }
928 101         182 foreach (keys %seenthis) {
929 516 100       855 push(@uniquethis, $_) unless ($alldeductions{$_});
930             }
931 101         175 $xunique[$i] = \@uniquethis;
932 101         406 $xdisjoint[$i][$i] = 0;
933             }
934             # @xunique is now available for use in further calculations,
935             # such as returning the items unique to a particular source list.
936              
937             # Calculate @xcomplement
938             # Inputs: @arrayrefs %seen @union
939 19         62 for (my $i = 0; $i <= $#arrayrefs; $i++) {
940 101         88 my %seenthis = %{$seen{$i}};
  101         296  
941 101         122 my @complementthis = ();
942 101         111 foreach (@union) {
943 1133 100       1768 push(@complementthis, $_) unless (exists $seenthis{$_});
944             }
945 101         307 $xcomplement[$i] = \@complementthis;
946             }
947             # @xcomplement is now available for use in further calculations,
948             # such as returning the items in all lists different from those in a
949             # particular source list.
950              
951             # Calculate @shared and @symmetric_difference
952             # Inputs: %xintersection @union
953 19         74 foreach my $q (keys %xintersection) {
954 223         154 $shared{$_}++ foreach (keys %{$xintersection{$q}});
  223         573  
955             }
956 19 100       141 @shared = $unsortflag ? keys %shared : sort(keys %shared);
957 19         41 foreach (@union) {
958 207 100       318 push(@symmetric_difference, $_) unless (exists $shared{$_});
959             }
960             # @shared and @symmetric_difference are now available.
961              
962 19         33 my @xsubset = ();
963 19         68 foreach my $i (keys %seen) {
964 101         86 my %tempi = %{$seen{$i}};
  101         267  
965 101         184 foreach my $j (keys %seen) {
966 547         393 my %tempj = %{$seen{$j}};
  547         1235  
967 547         849 $xsubset[$i][$j] = 1;
968 547         781 foreach (keys %tempi) {
969 2808 100       4843 $xsubset[$i][$j] = 0 if (! $tempj{$_});
970             }
971             }
972             }
973             # @xsubset is now available
974              
975 19         39 my @xequivalent = ();
976 19         59 for (my $f = 0; $f <= $#xsubset; $f++) {
977 101         169 for (my $g = 0; $g <= $#xsubset; $g++) {
978 547         534 $xequivalent[$f][$g] = 0;
979 547 100 100     1703 $xequivalent[$f][$g] = 1
980             if ($xsubset[$f][$g] and $xsubset[$g][$f]);
981             }
982             }
983              
984 19         28 my (%data);
985 19         54 $data{'seen'} = \%seen;
986 19         42 $data{'maxindex'} = $maxindex;
987 19         37 $data{'intersection'} = \@intersection;
988 19         39 $data{'nonintersection'} = \@nonintersection;
989 19         32 $data{'union'} = \@union;
990 19         30 $data{'shared'} = \@shared;
991 19         29 $data{'symmetric_difference'} = \@symmetric_difference;
992 19         65 $data{'xunique'} = \@xunique;
993 19         35 $data{'xcomplement'} = \@xcomplement;
994 19         32 $data{'xsubset'} = \@xsubset;
995 19         27 $data{'xequivalent'} = \@xequivalent;
996 19         35 $data{'xdisjoint'} = \@xdisjoint;
997 19         30 $data{'bag'} = \@bag;
998 19         260 return \%data;
999             }
1000              
1001             sub get_intersection {
1002 8     8   4594 return @{ get_intersection_ref(shift) };
  8         27  
1003             }
1004              
1005             sub get_intersection_ref {
1006 16     16   4285 my $class = shift;
1007 16         118 my %data = %$class;
1008 16         90 return $data{'intersection'};
1009             }
1010              
1011             sub get_union {
1012 8     8   3370 return @{ get_union_ref(shift) };
  8         27  
1013             }
1014              
1015             sub get_union_ref {
1016 16     16   5355 my $class = shift;
1017 16         114 my %data = %$class;
1018 16         131 return $data{'union'};
1019             }
1020              
1021             sub get_shared {
1022 8     8   5010 return @{ get_shared_ref(shift) };
  8         29  
1023             }
1024              
1025             sub get_shared_ref {
1026 16     16   4883 my $class = shift;
1027 16         122 my %data = %$class;
1028 16         80 return $data{'shared'};
1029             }
1030              
1031             sub get_unique {
1032 36     36   8633 my $class = shift;
1033 36         282 my %data = %$class;
1034 36 100       122 my $index = defined $_[0] ? shift : 0;
1035 36         42 return @{ get_unique_ref($class, $index) };
  36         78  
1036             }
1037              
1038             sub get_unique_ref {
1039 77     77   8805 my $class = shift;
1040 77         504 my %data = %$class;
1041 77 100       211 my $index = defined $_[0] ? shift : 0;
1042 77         243 _index_message1($index, \%data);
1043 72         77 return ${$data{'xunique'}}[$index];
  72         498  
1044             }
1045              
1046             sub get_unique_all {
1047 8     8   9514 my $class = shift;
1048 8         69 my %data = %$class;
1049 8         32 return $data{'xunique'};
1050             }
1051              
1052             sub get_Lonly {
1053 24     24   42023 my ($class, $index) = @_;
1054 24         169 my $method = (caller(0))[3];
1055 24         225 $method =~ s/.*::(\w*)$/$1/;
1056 24         2800 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1057 24         1631 get_unique($class, $index);
1058             }
1059              
1060             sub get_Lonly_ref {
1061 24     24   46587 my ($class, $index) = @_;
1062 24         128 my $method = (caller(0))[3];
1063 24         190 $method =~ s/.*::(\w*)$/$1/;
1064 24         2400 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1065 24         1621 get_unique_ref($class, $index);
1066             }
1067              
1068             *get_Aonly = \&get_Lonly;
1069             *get_Aonly_ref = \&get_Lonly_ref;
1070              
1071             sub get_complement {
1072 44     44   18014 my $class = shift;
1073 44         313 my %data = %$class;
1074 44 100       132 my $index = defined $_[0] ? shift : 0;
1075 44         49 return @{ get_complement_ref($class, $index) };
  44         92  
1076             }
1077              
1078             sub get_complement_ref {
1079 93     93   10783 my $class = shift;
1080 93         500 my %data = %$class;
1081 93 100       231 my $index = defined $_[0] ? shift : 0;
1082 93         271 _index_message1($index, \%data);
1083 88         88 return ${$data{'xcomplement'}}[$index];
  88         631  
1084             }
1085              
1086             sub get_complement_all {
1087 8     8   8376 my $class = shift;
1088 8         78 my %data = %$class;
1089 8         39 return $data{'xcomplement'};
1090             }
1091              
1092             sub get_Ronly {
1093 28     28   44056 my ($class, $index) = @_;
1094 28         154 my $method = (caller(0))[3];
1095 28         213 $method =~ s/.*::(\w*)$/$1/;
1096 28         2752 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1097 28         1677 &get_complement($class, $index);
1098             }
1099              
1100             sub get_Ronly_ref {
1101 28     28   53695 my ($class, $index) = @_;
1102 28         153 my $method = (caller(0))[3];
1103 28         209 $method =~ s/.*::(\w*)$/$1/;
1104 28         2808 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1105 28         1752 &get_complement_ref($class, $index);
1106             }
1107              
1108             *get_Bonly = \&get_Ronly;
1109             *get_Bonly_ref = \&get_Ronly_ref;
1110              
1111             sub get_symmetric_difference {
1112 32     32   14388 return @{ get_symmetric_difference_ref(shift) };
  32         74  
1113             }
1114              
1115             sub get_symmetric_difference_ref {
1116 64     64   8770 my $class = shift;
1117 64         527 my %data = %$class;
1118 64         381 return $data{'symmetric_difference'};
1119             }
1120              
1121             *get_symdiff = \&get_symmetric_difference;
1122             *get_symdiff_ref = \&get_symmetric_difference_ref;
1123              
1124             sub get_LorRonly {
1125 16     16   25684 my $class = shift;
1126 16         88 my $method = (caller(0))[3];
1127 16         124 $method =~ s/.*::(\w*)$/$1/;
1128 16         1810 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1129 16         926 get_symmetric_difference($class);
1130             }
1131              
1132             sub get_LorRonly_ref {
1133 16     16   31282 my $class = shift;
1134 16         100 my $method = (caller(0))[3];
1135 16         135 $method =~ s/.*::(\w*)$/$1/;
1136 16         1745 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1137 16         1066 get_symmetric_difference_ref($class);
1138             }
1139              
1140             *get_AorBonly = \&get_LorRonly;
1141             *get_AorBonly_ref = \&get_LorRonly_ref;
1142              
1143             sub get_nonintersection {
1144 8     8   10208 return @{ get_nonintersection_ref(shift) };
  8         35  
1145             }
1146              
1147             sub get_nonintersection_ref {
1148 16     16   4901 my $class = shift;
1149 16         135 my %data = %$class;
1150 16         92 return $data{'nonintersection'};
1151             }
1152              
1153             sub is_LsubsetR {
1154 57     57   17517 my $class = shift;
1155 57         407 my %data = %$class;
1156 57         246 my ($index_left, $index_right) = _index_message2(\%data, @_);
1157 48         65 my @subset_array = @{$data{'xsubset'}};
  48         120  
1158 48         75 my $subset_status = $subset_array[$index_left][$index_right];
1159 48         165 return $subset_status;
1160             }
1161              
1162             *is_AsubsetB = \&is_LsubsetR;
1163              
1164             sub is_RsubsetL {
1165 16     16   23049 my $class = shift;
1166 16         134 my %data = %$class;
1167 16         86 my $method = (caller(0))[3];
1168 16         126 $method =~ s/.*::(\w*)$/$1/;
1169 16         1841 carp "When comparing 3 or more lists, \&$method or its alias is restricted to \n asking if the list which is the 2nd argument to the constructor \n is a subset of the list which is the 1st argument.\n For greater flexibility, please re-code with \&is_LsubsetR: $!";
1170 16         1209 @_ = (1,0);
1171 16         71 my ($index_left, $index_right) = _index_message2(\%data, @_);
1172 16         24 my @subset_array = @{$data{'xsubset'}};
  16         47  
1173 16         33 my $subset_status = $subset_array[$index_left][$index_right];
1174 16         113 return $subset_status;
1175             }
1176              
1177             *is_BsubsetA = \&is_RsubsetL;
1178              
1179             sub is_LequivalentR {
1180 33     33   14293 my $class = shift;
1181 33         243 my %data = %$class;
1182 33         138 my ($index_left, $index_right) = _index_message2(\%data, @_);
1183 24         41 my @equivalent_array = @{$data{'xequivalent'}};
  24         64  
1184 24         47 my $equivalent_status = $equivalent_array[$index_left][$index_right];
1185 24         80 return $equivalent_status;
1186             }
1187              
1188             *is_LeqvlntR = \&is_LequivalentR;
1189              
1190             sub is_LdisjointR {
1191 29     29   7412 my $class = shift;
1192 29         235 my %data = %$class;
1193 29         122 my ($index_left, $index_right) = _index_message2(\%data, @_);
1194 24         32 my @disjoint_array = @{$data{'xdisjoint'}};
  24         65  
1195 24         44 my $disjoint_status = $disjoint_array[$index_left][$index_right];
1196 24         82 return $disjoint_status;
1197             }
1198              
1199             sub is_member_which {
1200 92     92   15326 return @{ is_member_which_ref(@_) };
  92         154  
1201             }
1202              
1203             sub is_member_which_ref {
1204 185     185   17717 my $class = shift;
1205 185 100 100     1850 croak "Method call requires exactly 1 argument (no references): $!"
1206             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1207 176         741 my %data = %$class;
1208 176         214 my %seen = %{$data{'seen'}};
  176         457  
1209 176         171 my ($arg, @found);
1210 176         153 $arg = shift;
1211 176         442 foreach (sort keys %seen) {
1212 880 100       1657 push @found, $_ if (exists $seen{$_}{$arg});
1213             }
1214 176         776 return \@found;
1215             }
1216              
1217             sub are_members_which {
1218 13     13   17631 my $class = shift;
1219 13 100 100     657 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
1220             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
1221 8         67 my %data = %$class;
1222 8         19 my %seen = %{$data{'seen'}};
  8         46  
1223 8         12 my (@args, %found);
1224 8         12 @args = @{$_[0]};
  8         30  
1225 8         37 for (my $i=0; $i<=$#args; $i++) {
1226 88         65 my (@not_found);
1227 88         198 foreach (sort keys %seen) {
1228 440         749 exists ${$seen{$_}}{$args[$i]}
  216         341  
1229 440 100       319 ? push @{$found{$args[$i]}}, $_
1230             : push @not_found, $_;
1231             }
1232 88 100       285 $found{$args[$i]} = [] if (@not_found == keys %seen);
1233             }
1234 8         45 return \%found;
1235             }
1236              
1237             sub is_member_any {
1238 93     93   11924 my $class = shift;
1239 93 100 100     853 croak "Method call requires exactly 1 argument (no references): $!"
1240             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1241 88         387 my %data = %$class;
1242 88         118 my %seen = %{$data{'seen'}};
  88         234  
1243 88         94 my ($arg, $k);
1244 88         85 $arg = shift;
1245 88         176 while ( $k = each %seen ) {
1246 196 100       702 return 1 if (defined $seen{$k}{$arg});
1247             }
1248 8         38 return 0;
1249             }
1250              
1251             sub are_members_any {
1252 13     13   5173 my $class = shift;
1253 13 100 100     557 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
1254             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
1255 8         84 my %data = %$class;
1256 8         21 my %seen = %{$data{'seen'}};
  8         40  
1257 8         16 my (@args, %present);
1258 8         14 @args = @{$_[0]};
  8         32  
1259 8         76 for (my $i=0; $i<=$#args; $i++) {
1260 88         141 foreach (keys %seen) {
1261 440 100       841 unless (defined $present{$args[$i]}) {
1262 181 100       436 $present{$args[$i]} = 1 if $seen{$_}{$args[$i]};
1263             }
1264             }
1265 88 100       267 $present{$args[$i]} = 0 if (! defined $present{$args[$i]});
1266             }
1267 8         49 return \%present;
1268             }
1269              
1270             sub print_subset_chart {
1271 8     8   9075 my $class = shift;
1272 8         72 my %data = %$class;
1273 8         18 my @subset_array = @{$data{'xsubset'}};
  8         32  
1274 8         14 my $title = 'Subset';
1275 8         52 _chart_engine_multiple(\@subset_array, $title);
1276             }
1277              
1278             sub print_equivalence_chart {
1279 8     8   13628 my $class = shift;
1280 8         69 my %data = %$class;
1281 8         20 my @equivalent_array = @{$data{'xequivalent'}};
  8         29  
1282 8         180 my $title = 'Equivalence';
1283 8         33 _chart_engine_multiple(\@equivalent_array, $title);
1284             }
1285              
1286             sub get_bag {
1287 8     8   5134 return @{ get_bag_ref(shift) };
  8         32  
1288             }
1289              
1290             sub get_bag_ref {
1291 16     16   5409 my $class = shift;
1292 16         118 my %data = %$class;
1293 16         132 return $data{'bag'};
1294             }
1295              
1296             sub get_version {
1297 8     8   3448 return $List::Compare::VERSION;
1298             }
1299              
1300             1;
1301              
1302             ################################################################################
1303              
1304             package List::Compare::Multiple::Accelerated;
1305 34     34   299 use Carp;
  34         50  
  34         2722  
1306 34         2723 use List::Compare::Base::_Auxiliary qw(
1307             _argument_checker_0
1308             _prepare_listrefs
1309             _subset_subengine
1310             _chart_engine_multiple
1311             _equivalent_subengine
1312             _index_message3
1313             _index_message4
1314             _subset_engine_multaccel
1315 34     34   175 );
  34         44  
1316 34     34   161 use List::Compare::Base::_Auxiliary qw(:calculate);
  34         45  
  34         6369  
1317 34         125100 use List::Compare::Base::_Engine qw(
1318             _unique_all_engine
1319             _complement_all_engine
1320 34     34   20917 );
  34         65  
1321              
1322             sub _init {
1323 22     22   46 my $self = shift;
1324 22         29 my $unsortflag = shift;
1325 22         104 my @listrefs = _argument_checker_0(@_);
1326 22         94 my %data = ();
1327 22         85 for (my $i=0; $i<=$#listrefs; $i++) {
1328 118         327 $data{$i} = $listrefs[$i];
1329             }
1330 22 100       67 $data{'unsort'} = $unsortflag ? 1 : 0;
1331 22         58 return \%data;
1332             }
1333              
1334             sub get_union {
1335 8     8   4180 return @{ get_union_ref(shift) };
  8         26  
1336             }
1337              
1338             sub get_union_ref {
1339 16     16   5561 my $class = shift;
1340 16         160 my %data = %$class;
1341 16         32 my $unsortflag = $data{'unsort'};
1342 16         62 my $aref = _prepare_listrefs(\%data);
1343              
1344 16         50 my $unionref = _calculate_union_only($aref);
1345 16 100       31 my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref});
  8         39  
  8         59  
1346 16         110 return \@union;
1347             }
1348              
1349             sub get_intersection {
1350 8     8   5208 return @{ get_intersection_ref(shift) };
  8         29  
1351             }
1352              
1353             sub get_intersection_ref {
1354 16     16   4860 my $class = shift;
1355 16         76 my %data = %$class;
1356 16         33 my $unsortflag = $data{'unsort'};
1357 16         49 my $aref = _prepare_listrefs(\%data);
1358 16         51 my $intermediate_ref = _calculate_intermediate($aref);
1359 8         19 my @intersection =
1360 16 100       33 $unsortflag ? keys %{$intermediate_ref} : sort(keys %{$intermediate_ref});
  8         26  
1361 16         75 return \@intersection;
1362             }
1363              
1364             sub get_nonintersection {
1365 8     8   10279 return @{ get_nonintersection_ref(shift) };
  8         30  
1366             }
1367              
1368             sub get_nonintersection_ref {
1369 16     16   5036 my $class = shift;
1370 16         74 my %data = %$class;
1371 16         31 my $unsortflag = $data{'unsort'};
1372 16         50 my $aref = _prepare_listrefs(\%data);
1373              
1374 16         51 my $unionref = _calculate_union_only($aref);
1375 16         45 my $intermediate_ref = _calculate_intermediate($aref);
1376 16         21 my (@nonintersection);
1377 16         19 foreach my $el (keys %{$unionref}) {
  16         49  
1378 160 100       329 push(@nonintersection, $el) unless exists $intermediate_ref->{$el};
1379             }
1380 16 100       222 return [ $unsortflag ? @nonintersection : sort(@nonintersection) ];
1381             }
1382              
1383             sub get_shared {
1384 8     8   5453 return @{ get_shared_ref(shift) };
  8         28  
1385             }
1386              
1387             sub get_shared_ref {
1388 16     16   5418 my $class = shift;
1389 16         83 my %data = %$class;
1390 16         29 my $unsortflag = $data{'unsort'};
1391 16         56 my $aref = _prepare_listrefs(\%data);
1392 16         55 my $aseenref = _calculate_array_seen_only($aref);
1393 16         48 my $intermediate = _calculate_sharedref($aseenref);
1394 16 100       41 my @shared = $unsortflag ? keys %{$intermediate} : sort(keys %{$intermediate});
  8         28  
  8         47  
1395 16         147 return \@shared;
1396             }
1397              
1398             sub get_symmetric_difference {
1399 32     32   14321 return @{ get_symmetric_difference_ref(shift) };
  32         73  
1400             }
1401              
1402             sub get_symmetric_difference_ref {
1403 64     64   9428 my $class = shift;
1404 64         301 my %data = %$class;
1405 64         101 my $unsortflag = $data{'unsort'};
1406 64         239 my $aref = _prepare_listrefs(\%data);
1407 64         173 my $unionref = _calculate_union_only($aref);
1408              
1409 64         155 my $aseenref = _calculate_array_seen_only($aref);
1410 64         145 my $sharedref = _calculate_sharedref($aseenref);
1411              
1412 64         61 my (@symmetric_difference);
1413 64         67 foreach my $el (keys %{$unionref}) {
  64         175  
1414 640 100       993 push(@symmetric_difference, $el) unless exists $sharedref->{$el};
1415             }
1416 64 100       756 return [ $unsortflag ? @symmetric_difference : sort(@symmetric_difference) ];
1417             }
1418              
1419             *get_symdiff = \&get_symmetric_difference;
1420             *get_symdiff_ref = \&get_symmetric_difference_ref;
1421              
1422             sub get_LorRonly {
1423 16     16   24970 my $class = shift;
1424 16         86 my $method = (caller(0))[3];
1425 16         123 $method =~ s/.*::(\w*)$/$1/;
1426 16         1690 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1427 16         967 get_symmetric_difference($class);
1428             }
1429              
1430             sub get_LorRonly_ref {
1431 16     16   31862 my $class = shift;
1432 16         89 my $method = (caller(0))[3];
1433 16         127 $method =~ s/.*::(\w*)$/$1/;
1434 16         1622 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_symmetric_difference_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1435 16         886 get_symmetric_difference_ref($class);
1436             }
1437              
1438             *get_AorBonly = \&get_LorRonly;
1439             *get_AorBonly_ref = \&get_LorRonly_ref;
1440              
1441             sub get_unique {
1442 36     36   9730 my $class = shift;
1443 36         202 my %data = %$class;
1444 36 100       122 my $index = defined $_[0] ? shift : 0;
1445 36         42 return @{ get_unique_ref($class, $index) };
  36         82  
1446             }
1447              
1448             sub get_unique_ref {
1449 77     77   9911 my $class = shift;
1450 77         319 my %data = %$class;
1451 77 100       188 my $index = defined $_[0] ? shift : 0;
1452 77         249 my $aref = _prepare_listrefs(\%data);
1453 77         88 _index_message3($index, $#{$aref});
  77         262  
1454              
1455 72         207 my $unique_all_ref = _unique_all_engine($aref);
1456 72         78 return ${$unique_all_ref}[$index];
  72         536  
1457             }
1458              
1459             sub get_unique_all {
1460 8     8   10702 my $class = shift;
1461 8         50 my %data = %$class;
1462 8         38 my $aref = _prepare_listrefs(\%data);
1463 8         35 return _unique_all_engine($aref);
1464             }
1465              
1466             sub get_Lonly {
1467 24     24   77516 my ($class, $index) = @_;
1468 24         128 my $method = (caller(0))[3];
1469 24         201 $method =~ s/.*::(\w*)$/$1/;
1470 24         3349 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1471 24         1849 get_unique($class, $index);
1472             }
1473              
1474             sub get_Lonly_ref {
1475 24     24   51584 my ($class, $index) = @_;
1476 24         134 my $method = (caller(0))[3];
1477 24         198 $method =~ s/.*::(\w*)$/$1/;
1478 24         2616 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_unique_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1479 24         1512 get_unique_ref($class, $index);
1480             }
1481              
1482             *get_Aonly = \&get_Lonly;
1483             *get_Aonly_ref = \&get_Lonly_ref;
1484              
1485             sub get_complement {
1486 44     44   19344 my $class = shift;
1487 44         226 my %data = %$class;
1488 44 100       141 my $index = defined $_[0] ? shift : 0;
1489 44         49 return @{ get_complement_ref($class, $index) };
  44         96  
1490             }
1491              
1492             sub get_complement_ref {
1493 93     93   12145 my $class = shift;
1494 93         412 my %data = %$class;
1495 93 100       225 my $index = defined $_[0] ? shift : 0;
1496 93         117 my $unsortflag = $data{'unsort'};
1497 93         295 my $aref = _prepare_listrefs(\%data);
1498 93         100 _index_message3($index, $#{$aref});
  93         306  
1499              
1500 88         238 my $complement_all_ref = _complement_all_engine($aref, $unsortflag );
1501 88         85 return ${$complement_all_ref}[$index];
  88         614  
1502             }
1503              
1504             sub get_complement_all {
1505 8     8   8128 my $class = shift;
1506 8         43 my %data = %$class;
1507 8         35 my $aref = _prepare_listrefs(\%data);
1508 8         36 return _complement_all_engine($aref);
1509             }
1510              
1511             sub get_Ronly {
1512 28     28   46782 my ($class, $index) = @_;
1513 28         145 my $method = (caller(0))[3];
1514 28         215 $method =~ s/.*::(\w*)$/$1/;
1515 28         3025 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1516 28         1827 &get_complement($class, $index);
1517             }
1518              
1519             sub get_Ronly_ref {
1520 28     28   56716 my ($class, $index) = @_;
1521 28         145 my $method = (caller(0))[3];
1522 28         211 $method =~ s/.*::(\w*)$/$1/;
1523 28         2746 carp "When comparing 3 or more lists, \&$method or its alias defaults to \n ", 'get_complement_ref()', ". Though the results returned are valid, \n please consider re-coding with that method: $!";
1524 28         1687 &get_complement_ref($class, $index);
1525             }
1526              
1527             *get_Bonly = \&get_Ronly;
1528             *get_Bonly_ref = \&get_Ronly_ref;
1529              
1530             sub is_LsubsetR {
1531 48     48   16282 my $class = shift;
1532 48         289 my %data = %$class;
1533 48         160 my $subset_status = _subset_engine_multaccel(\%data, @_);
1534 40         136 return $subset_status;
1535             }
1536              
1537             *is_AsubsetB = \&is_LsubsetR;
1538              
1539             sub is_RsubsetL {
1540 16     16   24443 my $class = shift;
1541 16         93 my %data = %$class;
1542              
1543 16         88 my $method = (caller(0))[3];
1544 16         122 $method =~ s/.*::(\w*)$/$1/;
1545 16         1716 carp "When comparing 3 or more lists, \&$method or its alias is restricted to \n asking if the list which is the 2nd argument to the constructor \n is a subset of the list which is the 1st argument.\n For greater flexibility, please re-code with \&is_LsubsetR: $!";
1546 16         1114 @_ = (1,0);
1547              
1548 16         68 my $subset_status = _subset_engine_multaccel(\%data, @_);
1549 16         164 return $subset_status;
1550             }
1551              
1552             *is_BsubsetA = \&is_RsubsetL;
1553              
1554             sub is_LequivalentR {
1555 33     33   14177 my $class = shift;
1556 33         155 my %data = %$class;
1557 33         101 my $aref = _prepare_listrefs(\%data);
1558 33         39 my ($index_left, $index_right) = _index_message4($#{$aref}, @_);
  33         104  
1559              
1560 24         71 my $xequivalentref = _equivalent_subengine($aref);
1561 24         29 return ${$xequivalentref}[$index_left][$index_right];
  24         94  
1562             }
1563              
1564             *is_LeqvlntR = \&is_LequivalentR;
1565              
1566             sub is_LdisjointR {
1567 29     29   7237 my $class = shift;
1568 29         148 my %data = %$class;
1569 29         95 my $aref = _prepare_listrefs(\%data);
1570 29         36 my ($index_left, $index_right) = _index_message4($#{$aref}, @_);
  29         107  
1571 24         121 my $aseenref = _calculate_array_seen_only(
1572             [ $aref->[$index_left], $aref->[$index_right] ]
1573             );
1574 24         38 my $disjoint_status = 1;
1575 24         28 OUTER: for my $k (keys %{$aseenref->[0]}) {
  24         73  
1576 52 100       120 if ($aseenref->[1]->{$k}) {
1577 16         19 $disjoint_status = 0;
1578 16         33 last OUTER;
1579             }
1580             }
1581 24         137 return $disjoint_status;
1582             }
1583              
1584             sub is_member_which {
1585 92     92   15526 return @{ is_member_which_ref(@_) };
  92         137  
1586             }
1587              
1588             sub is_member_which_ref {
1589 185     185   17267 my $class = shift;
1590 185 100 100     1660 croak "Method call requires exactly 1 argument (no references): $!"
1591             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1592 176         137 my %data = %{$class};
  176         536  
1593 176         438 my $aref = _prepare_listrefs(\%data);
1594 176         337 my $seenref = _calculate_seen_only($aref);
1595 176         149 my ($arg, @found);
1596 176         166 $arg = shift;
1597 176         149 foreach (sort keys %{$seenref}) {
  176         530  
1598 880 100       557 push @found, $_ if (exists ${$seenref}{$_}{$arg});
  880         1804  
1599             }
1600 176         984 return \@found;
1601             }
1602              
1603             sub are_members_which {
1604 13     13   17235 my $class = shift;
1605 13 100 100     628 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
1606             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
1607 8         14 my %data = %{$class};
  8         48  
1608 8         37 my $aref = _prepare_listrefs(\%data);
1609 8         30 my $seenref = _calculate_seen_only($aref);
1610 8         15 my (@args, %found);
1611 8         14 @args = @{$_[0]};
  8         29  
1612 8         29 for (my $i=0; $i<=$#args; $i++) {
1613 88         76 my (@not_found);
1614 88         66 foreach (sort keys %{$seenref}) {
  88         210  
1615 440         264 exists ${${$seenref}{$_}}{$args[$i]}
  440         769  
  216         345  
1616 440 100       294 ? push @{$found{$args[$i]}}, $_
1617             : push @not_found, $_;
1618             }
1619 88 100       93 $found{$args[$i]} = [] if (@not_found == keys %{$seenref});
  88         267  
1620             }
1621 8         64 return \%found;
1622             }
1623              
1624             sub is_member_any {
1625 93     93   11930 my $class = shift;
1626 93 100 100     834 croak "Method call requires exactly 1 argument (no references): $!"
1627             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1628 88         263 my %data = %$class;
1629 88         211 my $aref = _prepare_listrefs(\%data);
1630 88         177 my $seenref = _calculate_seen_only($aref);
1631 88         80 my ($arg, $k);
1632 88         100 $arg = shift;
1633 88         69 while ( $k = each %{$seenref} ) {
  213         429  
1634 205 100       173 return 1 if (defined ${$seenref}{$k}{$arg});
  205         707  
1635             }
1636 8         46 return 0;
1637             }
1638              
1639             sub are_members_any {
1640 13     13   5211 my $class = shift;
1641 13 100 100     514 croak "Method call requires exactly 1 argument which must be an array reference\n holding the items to be tested: $!"
1642             unless (@_ == 1 and ref($_[0]) eq 'ARRAY');
1643 8         44 my %data = %$class;
1644 8         33 my $aref = _prepare_listrefs(\%data);
1645 8         26 my $seenref = _calculate_seen_only($aref);
1646 8         19 my (@args, %present);
1647 8         12 @args = @{$_[0]};
  8         31  
1648 8         33 for (my $i=0; $i<=$#args; $i++) {
1649 88         70 foreach (keys %{$seenref}) {
  88         131  
1650 440 100       648 unless (defined $present{$args[$i]}) {
1651 202 100       126 $present{$args[$i]} = 1 if ${$seenref}{$_}{$args[$i]};
  202         417  
1652             }
1653             }
1654 88 100       236 $present{$args[$i]} = 0 if (! defined $present{$args[$i]});
1655             }
1656 8         59 return \%present;
1657             }
1658              
1659             sub print_subset_chart {
1660 8     8   9132 my $class = shift;
1661 8         45 my %data = %$class;
1662 8         35 my $aref = _prepare_listrefs(\%data);
1663 8         95 my $xsubsetref = _subset_subengine($aref);
1664 8         16 my $title = 'Subset';
1665 8         32 _chart_engine_multiple($xsubsetref, $title);
1666             }
1667              
1668             sub print_equivalence_chart {
1669 8     8   13817 my $class = shift;
1670 8         49 my %data = %$class;
1671 8         34 my $aref = _prepare_listrefs(\%data);
1672 8         27 my $xequivalentref = _equivalent_subengine($aref);
1673 8         20 my $title = 'Equivalence';
1674 8         28 _chart_engine_multiple($xequivalentref, $title);
1675             }
1676              
1677             sub get_bag {
1678 8     8   5016 return @{ get_bag_ref(shift) };
  8         26  
1679             }
1680              
1681             sub get_bag_ref {
1682 16     16   5569 my $class = shift;
1683 16         80 my %data = %$class;
1684 16         41 my $unsortflag = $data{'unsort'};
1685 16         49 my $aref = _prepare_listrefs(\%data);
1686 16         25 my (@bag);
1687 16         20 my @listrefs = @{$aref};
  16         104  
1688 16 100       193 if (ref($listrefs[0]) eq 'ARRAY') {
1689 8         74 foreach my $lref (@listrefs) {
1690 40         26 foreach my $el (@{$lref}) {
  40         48  
1691 256         259 push(@bag, $el);
1692             }
1693             }
1694             } else {
1695 8         11 foreach my $lref (@listrefs) {
1696 40         34 foreach my $key (keys %{$lref}) {
  40         60  
1697 216         159 for (my $j=1; $j <= ${$lref}{$key}; $j++) {
  472         734  
1698 256         244 push(@bag, $key);
1699             }
1700             }
1701             }
1702             }
1703 16 100       85 @bag = sort(@bag) unless $unsortflag;
1704 16         104 return \@bag;
1705             }
1706              
1707             sub get_version {
1708 8     8   3421 return $List::Compare::VERSION;
1709             }
1710              
1711             1;
1712              
1713              
1714             #################### DOCUMENTATION ####################
1715              
1716             =head1 NAME
1717              
1718             List::Compare - Compare elements of two or more lists
1719              
1720             =head1 VERSION
1721              
1722             This document refers to version 0.53 of List::Compare. This version was
1723             released June 07 2015.
1724              
1725             =head1 SYNOPSIS
1726              
1727             The bare essentials:
1728              
1729             @Llist = qw(abel abel baker camera delta edward fargo golfer);
1730             @Rlist = qw(baker camera delta delta edward fargo golfer hilton);
1731              
1732             $lc = List::Compare->new(\@Llist, \@Rlist);
1733              
1734             @intersection = $lc->get_intersection;
1735             @union = $lc->get_union;
1736              
1737             ... and so forth.
1738              
1739             =head1 DISCUSSION: Modes and Methods
1740              
1741             =head2 Regular Case: Compare Two Lists
1742              
1743             =over 4
1744              
1745             =item * Constructor: C
1746              
1747             Create a List::Compare object. Put the two lists into arrays (named or
1748             anonymous) and pass references to the arrays to the constructor.
1749              
1750             @Llist = qw(abel abel baker camera delta edward fargo golfer);
1751             @Rlist = qw(baker camera delta delta edward fargo golfer hilton);
1752              
1753             $lc = List::Compare->new(\@Llist, \@Rlist);
1754              
1755             By default, List::Compare's methods return lists which are sorted using
1756             Perl's default C mode: ASCII-betical sorting. Should you
1757             not need to have these lists sorted, you may achieve a speed boost
1758             by constructing the List::Compare object with the unsorted option:
1759              
1760             $lc = List::Compare->new('-u', \@Llist, \@Rlist);
1761              
1762             or
1763              
1764             $lc = List::Compare->new('--unsorted', \@Llist, \@Rlist);
1765              
1766             =item * Alternative Constructor
1767              
1768             If you prefer a more explicit delineation of the types of arguments passed
1769             to a function, you may use this 'single hashref' kind of constructor to build a
1770             List::Compare object:
1771              
1772             $lc = List::Compare->new( { lists => [\@Llist, \@Rlist] } );
1773              
1774             or
1775              
1776             $lc = List::Compare->new( {
1777             lists => [\@Llist, \@Rlist],
1778             unsorted => 1,
1779             } );
1780              
1781             =item * C
1782              
1783             Get those items which appear at least once in both lists (their intersection).
1784              
1785             @intersection = $lc->get_intersection;
1786              
1787             =item * C
1788              
1789             Get those items which appear at least once in either list (their union).
1790              
1791             @union = $lc->get_union;
1792              
1793             =item * C
1794              
1795             Get those items which appear (at least once) only in the first list.
1796              
1797             @Lonly = $lc->get_unique;
1798             @Lonly = $lc->get_Lonly; # alias
1799              
1800             =item * C
1801              
1802             Get those items which appear (at least once) only in the second list.
1803              
1804             @Ronly = $lc->get_complement;
1805             @Ronly = $lc->get_Ronly; # alias
1806              
1807             =item * C
1808              
1809             Get those items which appear at least once in either the first or the second
1810             list, but not both.
1811              
1812             @LorRonly = $lc->get_symmetric_difference;
1813             @LorRonly = $lc->get_symdiff; # alias
1814             @LorRonly = $lc->get_LorRonly; # alias
1815              
1816             =item * C
1817              
1818             Make a bag of all those items in both lists. The bag differs from the
1819             union of the two lists in that it holds as many copies of individual
1820             elements as appear in the original lists.
1821              
1822             @bag = $lc->get_bag;
1823              
1824             =item * Return references rather than lists
1825              
1826             An alternative approach to the above methods: If you do not immediately
1827             require an array as the return value of the method call, but simply need
1828             a I to an (anonymous) array, use one of the following
1829             parallel methods:
1830              
1831             $intersection_ref = $lc->get_intersection_ref;
1832             $union_ref = $lc->get_union_ref;
1833             $Lonly_ref = $lc->get_unique_ref;
1834             $Lonly_ref = $lc->get_Lonly_ref; # alias
1835             $Ronly_ref = $lc->get_complement_ref;
1836             $Ronly_ref = $lc->get_Ronly_ref; # alias
1837             $LorRonly_ref = $lc->get_symmetric_difference_ref;
1838             $LorRonly_ref = $lc->get_symdiff_ref; # alias
1839             $LorRonly_ref = $lc->get_LorRonly_ref; # alias
1840             $bag_ref = $lc->get_bag_ref;
1841              
1842             =item * C
1843              
1844             Return a true value if the first argument passed to the constructor
1845             ('L' for 'left') is a subset of the second argument passed to the
1846             constructor ('R' for 'right').
1847              
1848             $LR = $lc->is_LsubsetR;
1849              
1850             Return a true value if R is a subset of L.
1851              
1852             $RL = $lc->is_RsubsetL;
1853              
1854             =item * C
1855              
1856             Return a true value if the two lists passed to the constructor are
1857             equivalent, I if every element in the left-hand list ('L') appears
1858             at least once in the right-hand list ('R') and I.
1859              
1860             $eqv = $lc->is_LequivalentR;
1861             $eqv = $lc->is_LeqvlntR; # alias
1862              
1863             =item * C
1864              
1865             Return a true value if the two lists passed to the constructor are
1866             disjoint, I if the two lists have zero elements in common (or, what
1867             is the same thing, if their intersection is an empty set).
1868              
1869             $disj = $lc->is_LdisjointR;
1870              
1871             =item * C
1872              
1873             Pretty-print a chart showing whether one list is a subset of the other.
1874              
1875             $lc->print_subset_chart;
1876              
1877             =item * C
1878              
1879             Pretty-print a chart showing whether the two lists are equivalent (same
1880             elements found at least once in both).
1881              
1882             $lc->print_equivalence_chart;
1883              
1884             =item * C
1885              
1886             Determine in I (if any) of the lists passed to the constructor a given
1887             string can be found. In list context, return a list of those indices in the
1888             constructor's argument list corresponding to lists holding the string being
1889             tested.
1890              
1891             @memb_arr = $lc->is_member_which('abel');
1892              
1893             In the example above, C<@memb_arr> will be:
1894              
1895             ( 0 )
1896              
1897             because C<'abel'> is found only in C<@Al> which holds position C<0> in the
1898             list of arguments passed to C.
1899              
1900             In scalar context, the return value is the number of lists passed to the
1901             constructor in which a given string is found.
1902              
1903             As with other List::Compare methods which return a list, you may wish the
1904             above method returned a (scalar) reference to an array holding the list:
1905              
1906             $memb_arr_ref = $lc->is_member_which_ref('baker');
1907              
1908             In the example above, C<$memb_arr_ref> will be:
1909              
1910             [ 0, 1 ]
1911              
1912             because C<'baker'> is found in C<@Llist> and C<@Rlist>, which hold positions
1913             C<0> and C<1>, respectively, in the list of arguments passed to C.
1914              
1915             B methods C and C test
1916             only one string at a time and hence take only one argument. To test more
1917             than one string at a time see the next method, C.
1918              
1919             =item * C
1920              
1921             Determine in I (if any) of the lists passed to the constructor one or
1922             more given strings can be found. The strings to be tested are placed in an
1923             array (named or anonymous); a reference to that array is passed to the method.
1924              
1925             $memb_hash_ref =
1926             $lc->are_members_which([ qw| abel baker fargo hilton zebra | ]);
1927              
1928             I In versions of List::Compare prior to 0.25 (April 2004), the
1929             strings to be tested could be passed as a flat list. This is no longer
1930             possible; the argument must now be a reference to an array.
1931              
1932             The return value is a reference to a hash of arrays. The
1933             key for each element in this hash is the string being tested. Each element's
1934             value is a reference to an anonymous array whose elements are those indices in
1935             the constructor's argument list corresponding to lists holding the strings
1936             being tested. In the examples above, C<$memb_hash_ref> will be:
1937              
1938             {
1939             abel => [ 0 ],
1940             baker => [ 0, 1 ],
1941             fargo => [ 0, 1 ],
1942             hilton => [ 1 ],
1943             zebra => [ ],
1944             };
1945              
1946             B C can take more than one argument;
1947             C and C each take only one argument.
1948             Unlike those two methods, C returns a hash reference.
1949              
1950             =item * C
1951              
1952             Determine whether a given string can be found in I of the lists passed as
1953             arguments to the constructor. Return 1 if a specified string can be found in
1954             any of the lists and 0 if not.
1955              
1956             $found = $lc->is_member_any('abel');
1957              
1958             In the example above, C<$found> will be C<1> because C<'abel'> is found in one
1959             or more of the lists passed as arguments to C.
1960              
1961             =item * C
1962              
1963             Determine whether a specified string or strings can be found in I of the
1964             lists passed as arguments to the constructor. The strings to be tested are
1965             placed in an array (named or anonymous); a reference to that array is passed to
1966             C.
1967              
1968             $memb_hash_ref = $lc->are_members_any([ qw| abel baker fargo hilton zebra | ]);
1969              
1970             I In versions of List::Compare prior to 0.25 (April 2004), the
1971             strings to be tested could be passed as a flat list. This is no longer
1972             possible; the argument must now be a reference to an array.
1973              
1974             The return value is a reference to a hash where an element's key is the
1975             string being tested and the element's value is 1 if the string can be
1976             found in I of the lists and 0 if not. In the examples above,
1977             C<$memb_hash_ref> will be:
1978              
1979             {
1980             abel => 1,
1981             baker => 1,
1982             fargo => 1,
1983             hilton => 1,
1984             zebra => 0,
1985             };
1986              
1987             C's value is C<0> because C is not found in either of the lists
1988             passed as arguments to C.
1989              
1990             =item * C
1991              
1992             Return current List::Compare version number.
1993              
1994             $vers = $lc->get_version;
1995              
1996             =back
1997              
1998             =head2 Accelerated Case: When User Only Wants a Single Comparison
1999              
2000             =over 4
2001              
2002             =item * Constructor C
2003              
2004             If you are certain that you will only want the results of a I
2005             comparison, computation may be accelerated by passing C<'-a'> or
2006             C<'--accelerated> as the first argument to the constructor.
2007              
2008             @Llist = qw(abel abel baker camera delta edward fargo golfer);
2009             @Rlist = qw(baker camera delta delta edward fargo golfer hilton);
2010              
2011             $lca = List::Compare->new('-a', \@Llist, \@Rlist);
2012              
2013             or
2014              
2015             $lca = List::Compare->new('--accelerated', \@Llist, \@Rlist);
2016              
2017             As with List::Compare's Regular case, should you not need to have
2018             a sorted list returned by an accelerated List::Compare method, you may
2019             achieve a speed boost by constructing the accelerated List::Compare object
2020             with the unsorted option:
2021              
2022             $lca = List::Compare->new('-u', '-a', \@Llist, \@Rlist);
2023              
2024             or
2025              
2026             $lca = List::Compare->new('--unsorted', '--accelerated', \@Llist, \@Rlist);
2027              
2028             =item * Alternative Constructor
2029              
2030             You may use the 'single hashref' constructor format to build a List::Compare
2031             object calling for the Accelerated mode:
2032              
2033             $lca = List::Compare->new( {
2034             lists => [\@Llist, \@Rlist],
2035             accelerated => 1,
2036             } );
2037              
2038             or
2039              
2040             $lca = List::Compare->new( {
2041             lists => [\@Llist, \@Rlist],
2042             accelerated => 1,
2043             unsorted => 1,
2044             } );
2045              
2046             =item * Methods
2047              
2048             All the comparison methods available in the Regular case are available to
2049             you in the Accelerated case as well.
2050              
2051             @intersection = $lca->get_intersection;
2052             @union = $lca->get_union;
2053             @Lonly = $lca->get_unique;
2054             @Ronly = $lca->get_complement;
2055             @LorRonly = $lca->get_symmetric_difference;
2056             @bag = $lca->get_bag;
2057             $intersection_ref = $lca->get_intersection_ref;
2058             $union_ref = $lca->get_union_ref;
2059             $Lonly_ref = $lca->get_unique_ref;
2060             $Ronly_ref = $lca->get_complement_ref;
2061             $LorRonly_ref = $lca->get_symmetric_difference_ref;
2062             $bag_ref = $lca->get_bag_ref;
2063             $LR = $lca->is_LsubsetR;
2064             $RL = $lca->is_RsubsetL;
2065             $eqv = $lca->is_LequivalentR;
2066             $disj = $lca->is_LdisjointR;
2067             $lca->print_subset_chart;
2068             $lca->print_equivalence_chart;
2069             @memb_arr = $lca->is_member_which('abel');
2070             $memb_arr_ref = $lca->is_member_which_ref('baker');
2071             $memb_hash_ref = $lca->are_members_which(
2072             [ qw| abel baker fargo hilton zebra | ]);
2073             $found = $lca->is_member_any('abel');
2074             $memb_hash_ref = $lca->are_members_any(
2075             [ qw| abel baker fargo hilton zebra | ]);
2076             $vers = $lca->get_version;
2077              
2078             All the aliases for methods available in the Regular case are available to
2079             you in the Accelerated case as well.
2080              
2081             =back
2082              
2083             =head2 Multiple Case: Compare Three or More Lists
2084              
2085             =over 4
2086              
2087             =item * Constructor C
2088              
2089             Create a List::Compare object. Put each list into an array and pass
2090             references to the arrays to the constructor.
2091              
2092             @Al = qw(abel abel baker camera delta edward fargo golfer);
2093             @Bob = qw(baker camera delta delta edward fargo golfer hilton);
2094             @Carmen = qw(fargo golfer hilton icon icon jerky kappa);
2095             @Don = qw(fargo icon jerky);
2096             @Ed = qw(fargo icon icon jerky);
2097              
2098             $lcm = List::Compare->new(\@Al, \@Bob, \@Carmen, \@Don, \@Ed);
2099              
2100             As with List::Compare's Regular case, should you not need to have
2101             a sorted list returned by a List::Compare method, you may achieve a
2102             speed boost by constructing the object with the unsorted option:
2103              
2104             $lcm = List::Compare->new('-u', \@Al, \@Bob, \@Carmen, \@Don, \@Ed);
2105              
2106             or
2107              
2108             $lcm = List::Compare->new('--unsorted', \@Al, \@Bob, \@Carmen, \@Don, \@Ed);
2109              
2110             =item * Alternative Constructor
2111              
2112             You may use the 'single hashref' constructor format to build a List::Compare
2113             object to process three or more lists at once:
2114              
2115             $lcm = List::Compare->new( {
2116             lists => [\@Al, \@Bob, \@Carmen, \@Don, \@Ed],
2117             } );
2118              
2119             or
2120              
2121             $lcm = List::Compare->new( {
2122             lists => [\@Al, \@Bob, \@Carmen, \@Don, \@Ed],
2123             unsorted => 1,
2124             } );
2125              
2126             =item * Multiple Mode Methods Analogous to Regular and Accelerated Mode Methods
2127              
2128             Each List::Compare method available in the Regular and Accelerated cases
2129             has an analogue in the Multiple case. However, the results produced
2130             usually require more careful specification.
2131              
2132             B Certain of the following methods available in List::Compare's
2133             Multiple mode take optional numerical arguments where those numbers
2134             represent the index position of a particular list in the list of arguments
2135             passed to the constructor. To specify this index position correctly,
2136              
2137             =over 4
2138              
2139             =item *
2140              
2141             start the count at C<0> (as is customary with Perl array indices); and
2142              
2143             =item *
2144              
2145             do I count any unsorted option (C<'-u'> or C<'--unsorted'>) preceding
2146             the array references in the constructor's own argument list.
2147              
2148             =back
2149              
2150             Example:
2151              
2152             $lcmex = List::Compare->new('--unsorted', \@alpha, \@beta, \@gamma);
2153              
2154             For the purpose of supplying a numerical argument to a method which
2155             optionally takes such an argument, C<'--unsorted'> is skipped, C<@alpha>
2156             is C<0>, C<@beta> is C<1>, and so forth.
2157              
2158             =over 4
2159              
2160             =item * C
2161              
2162             Get those items found in I of the lists passed to the constructor
2163             (their intersection):
2164              
2165             @intersection = $lcm->get_intersection;
2166              
2167             =item * C
2168              
2169             Get those items found in I of the lists passed to the constructor
2170             (their union):
2171              
2172             @union = $lcm->get_union;
2173              
2174             =item * C
2175              
2176             To get those items which appear only in I provide
2177             C with that list's index position in the list of arguments
2178             passed to the constructor (not counting any C<'-u'> or C<'--unsorted'>
2179             option).
2180              
2181             Example: C<@Carmen> has index position C<2> in the constructor's C<@_>.
2182             To get elements unique to C<@Carmen>:
2183              
2184             @Lonly = $lcm->get_unique(2);
2185              
2186             If no index position is passed to C it will default to 0
2187             and report items unique to the first list passed to the constructor.
2188              
2189             =item * C
2190              
2191             To get those items which appear in any list I
2192             list,> provide C with that list's index position in
2193             the list of arguments passed to the constructor (not counting any
2194             C<'-u'> or C<'--unsorted'> option).
2195              
2196             Example: C<@Don> has index position C<3> in the constructor's C<@_>.
2197             To get elements not found in C<@Don>:
2198              
2199             @Ronly = $lcm->get_complement(3);
2200              
2201             If no index position is passed to C it will default to
2202             0 and report items found in any list other than the first list passed
2203             to the constructor.
2204              
2205             =item * C
2206              
2207             Get those items each of which appears in I of the lists
2208             passed to the constructor (their symmetric_difference);
2209              
2210             @LorRonly = $lcm->get_symmetric_difference;
2211              
2212             =item * C
2213              
2214             Make a bag of all items found in any list. The bag differs from the
2215             lists' union in that it holds as many copies of individual elements
2216             as appear in the original lists.
2217              
2218             @bag = $lcm->get_bag;
2219              
2220             =item * Return reference instead of list
2221              
2222             An alternative approach to the above methods: If you do not immediately
2223             require an array as the return value of the method call, but simply need
2224             a I to an array, use one of the following parallel methods:
2225              
2226             $intersection_ref = $lcm->get_intersection_ref;
2227             $union_ref = $lcm->get_union_ref;
2228             $Lonly_ref = $lcm->get_unique_ref(2);
2229             $Ronly_ref = $lcm->get_complement_ref(3);
2230             $LorRonly_ref = $lcm->get_symmetric_difference_ref;
2231             $bag_ref = $lcm->get_bag_ref;
2232              
2233             =item * C
2234              
2235             To determine whether one particular list is a subset of another list
2236             passed to the constructor, provide C with the index
2237             position of the presumed subset (ignoring any unsorted option), followed
2238             by the index position of the presumed superset.
2239              
2240             Example: To determine whether C<@Ed> is a subset of C<@Carmen>, call:
2241              
2242             $LR = $lcm->is_LsubsetR(4,2);
2243              
2244             A true value (C<1>) is returned if the left-hand list is a subset of the
2245             right-hand list; a false value (C<0>) is returned otherwise.
2246              
2247             If no arguments are passed, C defaults to C<(0,1)> and
2248             compares the first two lists passed to the constructor.
2249              
2250             =item * C
2251              
2252             To determine whether any two particular lists are equivalent to each
2253             other, provide C with their index positions in the
2254             list of arguments passed to the constructor (ignoring any unsorted option).
2255              
2256             Example: To determine whether C<@Don> and C<@Ed> are equivalent, call:
2257              
2258             $eqv = $lcm->is_LequivalentR(3,4);
2259              
2260             A true value (C<1>) is returned if the lists are equivalent; a false value
2261             (C<0>) otherwise.
2262              
2263             If no arguments are passed, C defaults to C<(0,1)> and
2264             compares the first two lists passed to the constructor.
2265              
2266             =item * C
2267              
2268             To determine whether any two particular lists are disjoint from each other
2269             (I have no members in common), provide C with their
2270             index positions in the list of arguments passed to the constructor
2271             (ignoring any unsorted option).
2272              
2273             Example: To determine whether C<@Don> and C<@Ed> are disjoint, call:
2274              
2275             $disj = $lcm->is_LdisjointR(3,4);
2276              
2277             A true value (C<1>) is returned if the lists are equivalent; a false value
2278             (C<0>) otherwise.
2279              
2280             If no arguments are passed, C defaults to C<(0,1)> and
2281             compares the first two lists passed to the constructor.
2282              
2283             =item * C
2284              
2285             Pretty-print a chart showing the subset relationships among the various
2286             source lists:
2287              
2288             $lcm->print_subset_chart;
2289              
2290             =item * C
2291              
2292             Pretty-print a chart showing the equivalence relationships among the
2293             various source lists:
2294              
2295             $lcm->print_equivalence_chart;
2296              
2297             =item * C
2298              
2299             Determine in I (if any) of the lists passed to the constructor a given
2300             string can be found. In list context, return a list of those indices in the
2301             constructor's argument list (ignoring any unsorted option) corresponding to i
2302             lists holding the string being tested.
2303              
2304             @memb_arr = $lcm->is_member_which('abel');
2305              
2306             In the example above, C<@memb_arr> will be:
2307              
2308             ( 0 )
2309              
2310             because C<'abel'> is found only in C<@Al> which holds position C<0> in the
2311             list of arguments passed to C.
2312              
2313             =item * C
2314              
2315             As with other List::Compare methods which return a list, you may wish the
2316             above method returned a (scalar) reference to an array holding the list:
2317              
2318             $memb_arr_ref = $lcm->is_member_which_ref('jerky');
2319              
2320             In the example above, C<$memb_arr_ref> will be:
2321              
2322             [ 3, 4 ]
2323              
2324             because C<'jerky'> is found in C<@Don> and C<@Ed>, which hold positions
2325             C<3> and C<4>, respectively, in the list of arguments passed to C.
2326              
2327             B methods C and C test
2328             only one string at a time and hence take only one argument. To test more
2329             than one string at a time see the next method, C.
2330              
2331             =item * C
2332              
2333             Determine in C (if any) of the lists passed to the constructor one or
2334             more given strings can be found. The strings to be tested are placed in an
2335             anonymous array, a reference to which is passed to the method.
2336              
2337             $memb_hash_ref =
2338             $lcm->are_members_which([ qw| abel baker fargo hilton zebra | ]);
2339              
2340             I In versions of List::Compare prior to 0.25 (April 2004), the
2341             strings to be tested could be passed as a flat list. This is no longer
2342             possible; the argument must now be a reference to an anonymous array.
2343              
2344             The return value is a reference to a hash of arrays. The
2345             key for each element in this hash is the string being tested. Each element's
2346             value is a reference to an anonymous array whose elements are those indices in
2347             the constructor's argument list corresponding to lists holding the strings
2348             being tested.
2349              
2350             In the two examples above, C<$memb_hash_ref> will be:
2351              
2352             {
2353             abel => [ 0 ],
2354             baker => [ 0, 1 ],
2355             fargo => [ 0, 1, 2, 3, 4 ],
2356             hilton => [ 1, 2 ],
2357             zebra => [ ],
2358             };
2359              
2360             B C can take more than one argument;
2361             C and C each take only one argument.
2362             C returns a hash reference; the other methods return
2363             either a list or a reference to an array holding that list, depending on
2364             context.
2365              
2366             =item * C
2367              
2368             Determine whether a given string can be found in I of the lists passed as
2369             arguments to the constructor.
2370              
2371             $found = $lcm->is_member_any('abel');
2372              
2373             Return C<1> if a specified string can be found in I of the lists
2374             and C<0> if not.
2375              
2376             In the example above, C<$found> will be C<1> because C<'abel'> is found in one
2377             or more of the lists passed as arguments to C.
2378              
2379             =item * C
2380              
2381             Determine whether a specified string or strings can be found in I of the
2382             lists passed as arguments to the constructor. The strings to be tested are
2383             placed in an array (anonymous or named), a reference to which is passed to
2384             the method.
2385              
2386             $memb_hash_ref = $lcm->are_members_any([ qw| abel baker fargo hilton zebra | ]);
2387              
2388             I In versions of List::Compare prior to 0.25 (April 2004), the
2389             strings to be tested could be passed as a flat list. This is no longer
2390             possible; the argument must now be a reference to an anonymous array.
2391              
2392             The return value is a reference to a hash where an element's key is the
2393             string being tested and the element's value is 1 if the string can be
2394             found in C of the lists and 0 if not.
2395             In the two examples above, C<$memb_hash_ref> will be:
2396              
2397             {
2398             abel => 1,
2399             baker => 1,
2400             fargo => 1,
2401             hilton => 1,
2402             zebra => 0,
2403             };
2404              
2405             C's value will be C<0> because C is not found in any of the
2406             lists passed as arguments to C.
2407              
2408             =item * C
2409              
2410             Return current List::Compare version number:
2411              
2412             $vers = $lcm->get_version;
2413              
2414             =back
2415              
2416             =item * Multiple Mode Methods Not Analogous to Regular and Accelerated Mode Methods
2417              
2418             =over 4
2419              
2420             =item * C
2421              
2422             Get those items found in I of the lists passed to the constructor which
2423             do I appear in I of the lists (I all items except those found
2424             in the intersection of the lists):
2425              
2426             @nonintersection = $lcm->get_nonintersection;
2427              
2428             =item * C
2429              
2430             Get those items which appear in more than one of the lists passed to the
2431             constructor (I all items except those found in their symmetric
2432             difference);
2433              
2434             @shared = $lcm->get_shared;
2435              
2436             =item * C
2437              
2438             If you only need a reference to an array as a return value rather than a
2439             full array, use the following alternative methods:
2440              
2441             $nonintersection_ref = $lcm->get_nonintersection_ref;
2442             $shared_ref = $lcm->get_shared_ref;
2443              
2444             =item * C
2445              
2446             Get a reference to an array of array references where each of the interior
2447             arrays holds the list of those items I to the list passed to the
2448             constructor with the same index position.
2449              
2450             $unique_all_ref = $lcm->get_unique_all();
2451              
2452             In the example above, C<$unique_all_ref> will hold:
2453              
2454             [
2455             [ qw| abel | ],
2456             [ ],
2457             [ qw| jerky | ],
2458             [ ],
2459             [ ],
2460             ]
2461              
2462             =item * C
2463              
2464             Get a reference to an array of array references where each of the interior
2465             arrays holds the list of those items in the I to the list
2466             passed to the constructor with the same index position.
2467              
2468             $complement_all_ref = $lcm->get_complement_all();
2469              
2470             In the example above, C<$complement_all_ref> will hold:
2471              
2472             [
2473             [ qw| hilton icon jerky | ],
2474             [ qw| abel icon jerky | ],
2475             [ qw| abel baker camera delta edward | ],
2476             [ qw| abel baker camera delta edward jerky | ],
2477             [ qw| abel baker camera delta edward jerky | ],
2478             ]
2479              
2480             =back
2481              
2482             =back
2483              
2484             =head2 Multiple Accelerated Case: Compare Three or More Lists but Request Only a Single Comparison among the Lists
2485              
2486             =over 4
2487              
2488             =item * Constructor C
2489              
2490             If you are certain that you will only want the results of a single
2491             comparison among three or more lists, computation may be accelerated
2492             by passing C<'-a'> or C<'--accelerated> as the first argument to
2493             the constructor.
2494              
2495             @Al = qw(abel abel baker camera delta edward fargo golfer);
2496             @Bob = qw(baker camera delta delta edward fargo golfer hilton);
2497             @Carmen = qw(fargo golfer hilton icon icon jerky kappa);
2498             @Don = qw(fargo icon jerky);
2499             @Ed = qw(fargo icon icon jerky);
2500              
2501             $lcma = List::Compare->new('-a',
2502             \@Al, \@Bob, \@Carmen, \@Don, \@Ed);
2503              
2504             As with List::Compare's other cases, should you not need to have
2505             a sorted list returned by a List::Compare method, you may achieve a
2506             speed boost by constructing the object with the unsorted option:
2507              
2508             $lcma = List::Compare->new('-u', '-a',
2509             \@Al, \@Bob, \@Carmen, \@Don, \@Ed);
2510              
2511             or
2512              
2513             $lcma = List::Compare->new('--unsorted', '--accelerated',
2514             \@Al, \@Bob, \@Carmen, \@Don, \@Ed);
2515              
2516             As was the case with List::Compare's Multiple mode, do not count the
2517             unsorted option (C<'-u'> or C<'--unsorted'>) or the accelerated option
2518             (C<'-a'> or C<'--accelerated'>) when determining the index position of
2519             a particular list in the list of array references passed to the constructor.
2520              
2521             Example:
2522              
2523             $lcmaex = List::Compare->new('--unsorted', '--accelerated',
2524             \@alpha, \@beta, \@gamma);
2525              
2526             =item * Alternative Constructor
2527              
2528             The 'single hashref' format may be used to construct a List::Compare
2529             object which calls for accelerated processing of three or more lists at once:
2530              
2531             $lcmaex = List::Compare->new( {
2532             accelerated => 1,
2533             lists => [\@alpha, \@beta, \@gamma],
2534             } );
2535              
2536             or
2537              
2538             $lcmaex = List::Compare->new( {
2539             unsorted => 1,
2540             accelerated => 1,
2541             lists => [\@alpha, \@beta, \@gamma],
2542             } );
2543              
2544             =item * Methods
2545              
2546             For the purpose of supplying a numerical argument to a method which
2547             optionally takes such an argument, C<'--unsorted'> and C<'--accelerated>
2548             are skipped, C<@alpha> is C<0>, C<@beta> is C<1>, and so forth. To get a
2549             list of those items unique to C<@gamma>, you would call:
2550              
2551             @gamma_only = $lcmaex->get_unique(2);
2552              
2553             =back
2554              
2555             =head2 Passing Seen-hashes to the Constructor Instead of Arrays
2556              
2557             =over 4
2558              
2559             =item * When Seen-Hashes Are Already Available to You
2560              
2561             Suppose that in a particular Perl program, you had to do extensive munging of
2562             data from an external source and that, once you had correctly parsed a line
2563             of data, it was easier to assign that datum to a hash than to an array.
2564             More specifically, suppose that you used each datum as the key to an element
2565             of a lookup table in the form of a I:
2566              
2567             my %Llist = (
2568             abel => 2,
2569             baker => 1,
2570             camera => 1,
2571             delta => 1,
2572             edward => 1,
2573             fargo => 1,
2574             golfer => 1,
2575             );
2576              
2577             my %Rlist = (
2578             baker => 1,
2579             camera => 1,
2580             delta => 2,
2581             edward => 1,
2582             fargo => 1,
2583             golfer => 1,
2584             hilton => 1,
2585             );
2586              
2587             In other words, suppose it was more convenient to compute a lookup table
2588             I a list than to compute that list explicitly.
2589              
2590             Since in almost all cases List::Compare takes the elements in the arrays
2591             passed to its constructor and I assigns them to elements in a
2592             seen-hash, why shouldn't you be able to pass (references to) seen-hashes
2593             I to the constructor and avoid unnecessary array
2594             assignments before the constructor is called?
2595              
2596             =item * Constructor C
2597              
2598             You can now do so:
2599              
2600             $lcsh = List::Compare->new(\%Llist, \%Rlist);
2601              
2602             =item * Methods
2603              
2604             I of List::Compare's output methods are supported I
2605             modification> when references to seen-hashes are passed to the constructor.
2606              
2607             @intersection = $lcsh->get_intersection;
2608             @union = $lcsh->get_union;
2609             @Lonly = $lcsh->get_unique;
2610             @Ronly = $lcsh->get_complement;
2611             @LorRonly = $lcsh->get_symmetric_difference;
2612             @bag = $lcsh->get_bag;
2613             $intersection_ref = $lcsh->get_intersection_ref;
2614             $union_ref = $lcsh->get_union_ref;
2615             $Lonly_ref = $lcsh->get_unique_ref;
2616             $Ronly_ref = $lcsh->get_complement_ref;
2617             $LorRonly_ref = $lcsh->get_symmetric_difference_ref;
2618             $bag_ref = $lcsh->get_bag_ref;
2619             $LR = $lcsh->is_LsubsetR;
2620             $RL = $lcsh->is_RsubsetL;
2621             $eqv = $lcsh->is_LequivalentR;
2622             $disj = $lcsh->is_LdisjointR;
2623             $lcsh->print_subset_chart;
2624             $lcsh->print_equivalence_chart;
2625             @memb_arr = $lsch->is_member_which('abel');
2626             $memb_arr_ref = $lsch->is_member_which_ref('baker');
2627             $memb_hash_ref = $lsch->are_members_which(
2628             [ qw| abel baker fargo hilton zebra | ]);
2629             $found = $lsch->is_member_any('abel');
2630             $memb_hash_ref = $lsch->are_members_any(
2631             [ qw| abel baker fargo hilton zebra | ]);
2632             $vers = $lcsh->get_version;
2633             $unique_all_ref = $lcsh->get_unique_all();
2634             $complement_all_ref = $lcsh->get_complement_all();
2635              
2636             =item * Accelerated Mode and Seen-Hashes
2637              
2638             To accelerate processing when you want only a single comparison among two or
2639             more lists, you can pass C<'-a'> or C<'--accelerated> to the constructor
2640             before passing references to seen-hashes.
2641              
2642             $lcsha = List::Compare->new('-a', \%Llist, \%Rlist);
2643              
2644             To compare three or more lists simultaneously, pass three or more references
2645             to seen-hashes. Thus,
2646              
2647             $lcshm = List::Compare->new(\%Alpha, \%Beta, \%Gamma);
2648              
2649             will generate meaningful comparisons of three or more lists simultaneously.
2650              
2651             =item * Unsorted Results and Seen-Hashes
2652              
2653             If you do not need sorted lists returned, pass C<'-u'> or C<--unsorted> to the
2654             constructor before passing references to seen-hashes.
2655              
2656             $lcshu = List::Compare->new('-u', \%Llist, \%Rlist);
2657             $lcshau = List::Compare->new('-u', '-a', \%Llist, \%Rlist);
2658             $lcshmu = List::Compare->new('--unsorted', \%Alpha, \%Beta, \%Gamma);
2659              
2660             As was true when we were using List::Compare's Multiple and Multiple Accelerated
2661             modes, do not count any unsorted or accelerated option when determining the
2662             array index of a particular seen-hash reference passed to the constructor.
2663              
2664             =item * Alternative Constructor
2665              
2666             The 'single hashref' form of constructor is also available to build
2667             List::Compare objects where seen-hashes are used as arguments:
2668              
2669             $lcshu = List::Compare->new( {
2670             unsorted => 1,
2671             lists => [\%Llist, \%Rlist],
2672             } );
2673              
2674             $lcshau = List::Compare->new( {
2675             unsorted => 1,
2676             accelerated => 1,
2677             lists => [\%Llist, \%Rlist],
2678             } );
2679              
2680             $lcshmu = List::Compare->new( {
2681             unsorted => 1,
2682             lists => [\%Alpha, \%Beta, \%Gamma],
2683             } );
2684              
2685             =back
2686              
2687             =head1 DISCUSSION: Principles
2688              
2689             =head2 General Comments
2690              
2691             List::Compare is an object-oriented implementation of very common Perl
2692             code (see "History, References and Development" below) used to
2693             determine interesting relationships between two or more lists at a time.
2694             A List::Compare object is created and automatically computes the values
2695             needed to supply List::Compare methods with appropriate results. In the
2696             current implementation List::Compare methods will return new lists
2697             containing the items found in any designated list alone (unique), any list
2698             other than a designated list (complement), the intersection and union of
2699             all lists and so forth. List::Compare also has (a) methods to return Boolean
2700             values indicating whether one list is a subset of another and whether any
2701             two lists are equivalent to each other (b) methods to pretty-print very
2702             simple charts displaying the subset and equivalence relationships among
2703             lists.
2704              
2705             Except for List::Compare's C method, B
2706             an element in a given list count only once with
2707             respect to computing the intersection, union, etc. of the two lists.> In
2708             particular, List::Compare considers two lists as equivalent if each element
2709             of the first list can be found in the second list and I.
2710             'Equivalence' in this usage takes no note of the frequency with which
2711             elements occur in either list or their order within the lists. List::Compare
2712             asks the question: I Only when
2713             you use C to compute a bag holding the two lists do you
2714             ask the question: How many times did this item occur in this list?
2715              
2716             =head2 List::Compare Modes
2717              
2718             In its current implementation List::Compare has four modes of operation.
2719              
2720             =over 4
2721              
2722             =item *
2723              
2724             Regular Mode
2725              
2726             List::Compare's Regular mode is based on List::Compare v0.11 -- the first
2727             version of List::Compare released to CPAN (June 2002). It compares only
2728             two lists at a time. Internally, its initializer does all computations
2729             needed to report any desired comparison and its constructor stores the
2730             results of these computations. Its public methods merely report these
2731             results.
2732              
2733             This approach has the advantage that if you need to examine more
2734             than one form of comparison between two lists (I the union,
2735             intersection and symmetric difference of two lists), the comparisons are
2736             pre-calculated. This approach is efficient because certain types of
2737             comparison presuppose that other types have already been calculated.
2738             For example, to calculate the symmetric difference of two lists, one must
2739             first determine the items unique to each of the two lists.
2740              
2741             =item *
2742              
2743             Accelerated Mode
2744              
2745             The current implementation of List::Compare offers you the option of
2746             getting even faster results I that you only need the
2747             result from a I form of comparison between two lists. (I only
2748             the union -- nothing else). In the Accelerated mode, List::Compare's
2749             initializer does no computation and its constructor stores only references
2750             to the two source lists. All computation needed to report results is
2751             deferred to the method calls.
2752              
2753             The user selects this approach by passing the option flag C<'-a'> to the
2754             constructor before passing references to the two source lists.
2755             List::Compare notes the option flag and silently switches into Accelerated
2756             mode. From the perspective of the user, there is no further difference in
2757             the code or in the results.
2758              
2759             Benchmarking suggests that List::Compare's Accelerated mode (a) is faster
2760             than its Regular mode when only one comparison is requested; (b) is about as
2761             fast as Regular mode when two comparisons are requested; and (c) becomes
2762             considerably slower than Regular mode as each additional comparison above two
2763             is requested.
2764              
2765             =item *
2766              
2767             Multiple Mode
2768              
2769             List::Compare now offers the possibility of comparing three or more lists at
2770             a time. Simply store the extra lists in arrays and pass references to those
2771             arrays to the constructor. List::Compare detects that more than two lists
2772             have been passed to the constructor and silently switches into Multiple mode.
2773              
2774             As described in the Synopsis above, comparing more than two lists at a time
2775             offers you a wider, more complex palette of comparison methods.
2776             Individual items may appear in just one source list, in all the source lists,
2777             or in some number of lists between one and all. The meaning of 'union',
2778             'intersection' and 'symmetric difference' is conceptually unchanged
2779             when you move to multiple lists because these are properties of all the lists
2780             considered together. In contrast, the meaning of 'unique', 'complement',
2781             'subset' and 'equivalent' changes because these are properties of one list
2782             compared with another or with all the other lists combined.
2783              
2784             List::Compare takes this complexity into account by allowing you to pass
2785             arguments to the public methods requesting results with respect to a specific
2786             list (for C and C) or a specific pair of lists
2787             (for C and C).
2788              
2789             List::Compare further takes this complexity into account by offering the
2790             new methods C and C described in the
2791             Synopsis above.
2792              
2793             =item *
2794              
2795             Multiple Accelerated Mode
2796              
2797             Beginning with version 0.25, introduced in April 2004, List::Compare
2798             offers the possibility of accelerated computation of a single comparison
2799             among three or more lists at a time. Simply store the extra lists in
2800             arrays and pass references to those arrays to the constructor preceded by
2801             the C<'-a'> argument as was done with the simple (two lists only)
2802             accelerated mode. List::Compare detects that more than two lists have been
2803             passed to the constructor and silently switches into Multiple Accelerated
2804             mode.
2805              
2806             =item *
2807              
2808             Unsorted Option
2809              
2810             When List::Compare is used to return lists representing various comparisons
2811             of two or more lists (I, the lists' union or intersection), the lists
2812             returned are, by default, sorted using Perl's default C mode:
2813             ASCII-betical sorting. Sorting produces results which are more easily
2814             human-readable but may entail a performance cost.
2815              
2816             Should you not need sorted results, you can avoid the potential
2817             performance cost by calling List::Compare's constructor using the unsorted
2818             option. This is done by calling C<'-u'> or C<'--unsorted'> as the first
2819             argument passed to the constructor, I, as an argument called before
2820             any references to lists are passed to the constructor.
2821              
2822             Note that if are calling List::Compare in the Accelerated or Multiple
2823             Accelerated mode I wish to have the lists returned in unsorted order,
2824             you I pass the argument for the unsorted option
2825             (C<'-u'> or C<'--unsorted'>) and I pass the argument for the
2826             Accelerated mode (C<'-a'> or C<'--accelerated'>).
2827              
2828             =back
2829              
2830             =head2 Miscellaneous Methods
2831              
2832             It would not really be appropriate to call C and
2833             C in Regular or Accelerated mode since they are
2834             conceptually based on the notion of comparing more than two lists at a time.
2835             However, there is always the possibility that a user may be comparing only two
2836             lists (accelerated or not) and may accidentally call one of those two methods.
2837             To prevent fatal run-time errors and to caution you to use a more
2838             appropriate method, these two methods are defined for Regular and Accelerated
2839             modes so as to return suitable results but also generate a carp message that
2840             advise you to re-code.
2841              
2842             Similarly, the method C is appropriate for the Regular and
2843             Accelerated modes but is not really appropriate for Multiple mode. As a
2844             defensive maneuver, it has been defined for Multiple mode so as to return
2845             suitable results but also to generate a carp message that advises you to
2846             re-code.
2847              
2848             In List::Compare v0.11 and earlier, the author provided aliases for various
2849             methods based on the supposition that the source lists would be referred to as
2850             'A' and 'B'. Now that you can compare more than two lists at a time, the author
2851             feels that it would be more appropriate to refer to the elements of two-argument
2852             lists as the left-hand and right-hand elements. Hence, we are discouraging the
2853             use of methods such as C, C and C as
2854             aliases for C, C and
2855             C. However, to guarantee backwards compatibility
2856             for the vast audience of Perl programmers using earlier versions of
2857             List::Compare (all 10e1 of you) these and similar methods for subset
2858             relationships are still defined.
2859              
2860             =head2 List::Compare::SeenHash Discontinued Beginning with Version 0.26
2861              
2862             Prior to v0.26, introduced April 11, 2004, if a user wished to pass
2863             references to seen-hashes to List::Compare's constructor rather than
2864             references to arrays, he or she had to call a different, parallel module:
2865             List::Compare::SeenHash. The code for that looked like this:
2866              
2867             use List::Compare::SeenHash;
2868              
2869             my %Llist = (
2870             abel => 2,
2871             baker => 1,
2872             camera => 1,
2873             delta => 1,
2874             edward => 1,
2875             fargo => 1,
2876             golfer => 1,
2877             );
2878              
2879             my %Rlist = (
2880             baker => 1,
2881             camera => 1,
2882             delta => 2,
2883             edward => 1,
2884             fargo => 1,
2885             golfer => 1,
2886             hilton => 1,
2887             );
2888              
2889             my $lcsh = List::Compare::SeenHash->new(\%Llist, \%Rlist);
2890              
2891             B All
2892             its functionality (and more) has been implemented in List::Compare itself,
2893             since a user can now pass I a series of array references I a
2894             series of seen-hash references to List::Compare's constructor.
2895              
2896             To simplify future maintenance of List::Compare, List::Compare::SeenHash.pm
2897             will no longer be distributed with List::Compare, nor will the files in the
2898             test suite which tested List::Compare::SeenHash upon installation be distributed.
2899              
2900             Should you still need List::Compare::SeenHash, use version 0.25 from CPAN, or
2901             simply edit your Perl programs which used List::Compare::SeenHash. Those
2902             scripts may be edited quickly with, for example, this editing command in
2903             Unix text editor F:
2904              
2905             :1,$s/List::Compare::SeenHash/List::Compare/gc
2906              
2907             =head2 A Non-Object-Oriented Interface: List::Compare::Functional
2908              
2909             Version 0.21 of List::Compare introduced List::Compare::Functional,
2910             a functional (I, non-object-oriented) interface to list comparison
2911             functions. List::Compare::Functional supports the same functions currently
2912             supported by List::Compare. It works similar to List::Compare's Accelerated
2913             and Multiple Accelerated modes (described above), bit it does not
2914             require use of the C<'-a'> flag in the function call.
2915             List::Compare::Functional will return unsorted comparisons of two lists by
2916             passing C<'-u'> or C<'--unsorted'> as the first argument to the function.
2917             Please see the documentation for List::Compare::Functional to learn how to
2918             import its functions into your main package.
2919              
2920             =head1 ASSUMPTIONS AND QUALIFICATIONS
2921              
2922             The program was created with Perl 5.6. The use of I to prepare
2923             the module's template installed C at the top of the
2924             module. This has been commented out in the actual module as the code
2925             appears to be compatible with earlier versions of Perl; how earlier the
2926             author cannot say. In particular, the author would like the module to
2927             be installable on older versions of MacPerl. As is, the author has
2928             successfully installed the module on Linux, Windows 9x and Windows 2000.
2929             See L for
2930             a list of other systems on which this version of List::Compare has been
2931             tested and installed.
2932              
2933             =head1 HISTORY, REFERENCES AND DEVELOPMENT
2934              
2935             =head2 The Code Itself
2936              
2937             List::Compare is based on code presented by Tom Christiansen & Nathan
2938             Torkington in I L
2939             (a.k.a. the 'Ram' book), O'Reilly & Associates, 1998, Recipes 4.7 and 4.8.
2940             Similar code is presented in the Camel book: I, by Larry
2941             Wall, Tom Christiansen, Jon Orwant.
2942             L, 3rd ed, O'Reilly & Associates,
2943             2000. The list comparison code is so basic and Perlish that I suspect it
2944             may have been written by Larry himself at the dawn of Perl time. The
2945             C method was inspired by Jarkko Hietaniemi's Set::Bag module
2946             and Daniel Berger's Set::Array module, both available on CPAN.
2947              
2948             List::Compare's original objective was simply to put this code in a modular,
2949             object-oriented framework. That framework, not surprisingly, is taken mostly
2950             from Damian Conway's I
2951             L, Manning Publications, 2000.
2952              
2953             With the addition of the Accelerated, Multiple and Multiple Accelerated
2954             modes, List::Compare expands considerably in both size and capabilities.
2955             Nonetheless, Tom and Nat's I code still lies at its core:
2956             the use of hashes as look-up tables to record elements seen in lists.
2957             Please note: List::Compare is not concerned with any concept of 'equality'
2958             among lists which hinges upon the frequency with which, or the order in
2959             which, elements appear in the lists to be compared. If this does not
2960             meet your needs, you should look elsewhere or write your own module.
2961              
2962             =head2 The Inspiration
2963              
2964             I realized the usefulness of putting the list comparison code into a
2965             module while preparing an introductory level Perl course given at the New
2966             School University's Computer Instruction Center in April-May 2002. I was
2967             comparing lists left and right. When I found myself writing very similar
2968             functions in different scripts, I knew a module was lurking somewhere.
2969             I learned the truth of the mantra ''Repeated Code is a Mistake'' from a
2970             2001 talk by Mark-Jason Dominus L to the New York
2971             Perlmongers L.
2972             See L.
2973              
2974             The first public presentation of this module took place at Perl Seminar
2975             New York L on May 21, 2002.
2976             Comments and suggestions were provided there and since by Glenn Maciag,
2977             Gary Benson, Josh Rabinowitz, Terrence Brannon and Dave Cross.
2978              
2979             The placement in the installation tree of Test::ListCompareSpecial came
2980             as a result of a question answered by Michael Graham in his talk
2981             ''Test::More to Test::Extreme'' given at Yet Another Perl Conference::Canada
2982             in Ottawa, Ontario, on May 16, 2003.
2983              
2984             In May-June 2003, Glenn Maciag made valuable suggestions which led to
2985             changes in method names and documentation in v0.20.
2986              
2987             Another presentation at Perl Seminar New York in
2988             October 2003 prompted me to begin planning List::Compare::Functional.
2989              
2990             In a November 2003 Perl Seminar New York presentation, Ben Holtzman
2991             discussed the performance costs entailed in Perl's C function.
2992             This led me to ask, ''Why should a user of List::Compare pay this performance
2993             cost if he or she doesn't need a human-readable list as a result (as
2994             would be the case if the list returned were used as the input into some
2995             other function)?'' This led to the development of List::Compare's
2996             unsorted option.
2997              
2998             An April 2004 offer by Kevin Carlson to write an article for I
2999             (L) led me to re-think whether a separate module
3000             (the former List::Compare::SeenHash) was truly needed when a user wanted
3001             to provide the constructor with references to seen-hashes rather than
3002             references to arrays. Since I had already adapted List::Compare::Functional
3003             to accept both kinds of arguments, I adapted List::Compare in the same
3004             manner. This meant that List::Compare::SeenHash and its related installation
3005             tests could be deprecated and deleted from the CPAN distribution.
3006              
3007             A remark by David H. Adler at a New York Perlmongers meeting in April 2004
3008             led me to develop the 'single hashref' alternative constructor format,
3009             introduced in version 0.29 the following month.
3010              
3011             Presentations at two different editions of Yet Another Perl Conference (YAPC)
3012             inspired the development of List::Compare versions 0.30 and 0.31. I was
3013             selected to give a talk on List::Compare at YAPC::NA::2004 in Buffalo. This
3014             spurred me to improve certain aspects of the documentation. Version 0.31
3015             owes its inspiration to one talk at the Buffalo YAPC and one earlier talk at
3016             YAPC::EU::2003 in Paris. In Paris I heard Paul Johnson speak on his CPAN
3017             module Devel::Cover and on coverage analysis more generally. That material
3018             was over my head at that time, but in Buffalo I heard Andy Lester discuss
3019             Devel::Cover as part of his discussion of testing and of the Phalanx project
3020             (L). This time I got it, and when I returned
3021             from Buffalo I applied Devel::Cover to List::Compare and wrote additional tests
3022             to improve its subroutine and statement coverage. In addition, I added two
3023             new methods, C and C. In writing these
3024             two methods, I followed a model of test-driven development much more so than
3025             in earlier versions of List::Compare and my other CPAN modules. The result?
3026             List::Compare's test suite grew by over 3300 tests to nearly 23,000 tests.
3027              
3028             At the Second New York Perl Hackathon (May 02 2015), a project was created to
3029             request performance improvements in certain List::Compare functions
3030             (L).
3031             Hackathon participant Michael Rawson submitted a pull request with changes to
3032             List::Compare::Base::_Auxiliary. After these revisions were benchmarked, a
3033             patch embodying the pull request was accepted, leading to CPAN version 0.53.
3034              
3035             =head2 If You Like List::Compare, You'll Love ...
3036              
3037             While preparing this module for distribution via CPAN, I had occasion to
3038             study a number of other modules already available on CPAN. Each of these
3039             modules is more sophisticated than List::Compare -- which is not surprising
3040             since all that List::Compare originally aspired to do was to avoid typing
3041             Cookbook code repeatedly. Here is a brief description of the features of
3042             these modules. (B The following discussion is only valid as
3043             of June 2002. Some of these modules may have changed since then.)
3044              
3045             =over 4
3046              
3047             =item *
3048              
3049             Algorithm::Diff - Compute 'intelligent' differences between two files/lists
3050             (L)
3051              
3052             Algorithm::Diff is a sophisticated module originally written by Mark-Jason
3053             Dominus, later maintained by Ned Konz, now maintained by Tye McQueen. Think of
3054             the Unix C utility and you're on the right track. Algorithm::Diff
3055             exports
3056             methods such as C, which ''computes the smallest set of additions and
3057             deletions necessary to turn the first sequence into the second, and returns a
3058             description of these changes.'' Algorithm::Diff is mainly concerned with the
3059             sequence of elements within two lists. It does not export functions for
3060             intersection, union, subset status, etc.
3061              
3062             =item *
3063              
3064             Array::Compare - Perl extension for comparing arrays
3065             (L)
3066              
3067             Array::Compare, by Dave Cross, asks whether two arrays
3068             are the same or different by doing a C on each string with a
3069             separator character and comparing the resulting strings. Like
3070             List::Compare, it is an object-oriented module. A sophisticated feature of
3071             Array::Compare is that it allows you to specify how 'whitespace' in an
3072             array (an element which is undefined, the empty string, or whitespace
3073             within an element) should be evaluated for purpose of determining equality
3074             or difference. It does not directly provide methods for intersection and
3075             union.
3076              
3077             =item *
3078              
3079             List::Util - A selection of general-utility list subroutines
3080             (L)
3081              
3082             List::Util, by Graham Barr, exports a variety of simple,
3083             useful functions for operating on one list at a time. The C function
3084             returns the lowest numerical value in a list; the C function returns
3085             the highest value; and so forth. List::Compare differs from List::Util in
3086             that it is object-oriented and that it works on two strings at a time
3087             rather than just one -- but it aims to be as simple and useful as
3088             List::Util. List::Util will be included in the standard Perl
3089             distribution as of Perl 5.8.0.
3090              
3091             Lists::Util (L),
3092             by Tassilo von Parseval, building on code by Terrence Brannon, provides
3093             methods
3094             which extend List::Util's functionality.
3095              
3096             =item *
3097              
3098             Quantum::Superpositions
3099             (L),
3100             originally by Damian Conway, now maintained by Steven Lembark is useful if, in
3101             addition to comparing lists, you need to emulate quantum supercomputing as
3102             well.
3103             Not for the eigen-challenged.
3104              
3105             =item *
3106              
3107             Set::Scalar - basic set operations
3108             (L)
3109              
3110             Set::Bag - bag (multiset) class
3111             (L)
3112              
3113             Both of these modules are by Jarkko Hietaniemi. Set::Scalar
3114             has methods to return the intersection, union, difference and symmetric
3115             difference of two sets, as well as methods to return items unique to a
3116             first set and complementary to it in a second set. It has methods for
3117             reporting considerably more variants on subset status than does
3118             List::Compare. However, benchmarking suggests that List::Compare, at
3119             least in Regular mode, is considerably faster than Set::Scalar for those
3120             comparison methods which List::Compare makes available.
3121              
3122             Set::Bag enables one to deal more flexibly with the situation in which one
3123             has more than one instance of an element in a list.
3124              
3125             =item *
3126              
3127             Set::Array - Arrays as objects with lots of handy methods (including set
3128             comparisons) and support for method chaining.
3129             (L)
3130              
3131             Set::Array, by Daniel Berger, now maintained by Ron Savage, ''aims to provide
3132             built-in methods for operations that people are always asking how to do,and
3133             which already exist in languages like Ruby.'' Among the many methods in
3134             this module are some for intersection, union, etc. To install Set::Array,
3135             you must first install the Want module, also available on CPAN.
3136              
3137             =back
3138              
3139             =head1 ADDITIONAL CONTRIBUTORS
3140              
3141             =over 4
3142              
3143             =item * Syohei YOSHIDA
3144              
3145             Pull request accepted May 22 2015.
3146              
3147             =item * Paulo Custodio
3148              
3149             Pull request accepted June 07 2015, correcting errors in C<_subset_subengine()>.
3150              
3151             =back
3152              
3153             =head1 BUGS
3154              
3155             There are no bug reports outstanding on List::Compare as of the most recent
3156             CPAN upload date of this distribution.
3157              
3158             =head1 SUPPORT
3159              
3160             Please report any bugs by mail to C
3161             or through the web interface at L.
3162              
3163             =head1 AUTHOR
3164              
3165             James E. Keenan (jkeenan@cpan.org). When sending correspondence, please
3166             include 'List::Compare' or 'List-Compare' in your subject line.
3167              
3168             Creation date: May 20, 2002. Last modification date: June 07 2015.
3169              
3170             Development repository: L
3171              
3172             =head1 COPYRIGHT
3173              
3174             Copyright (c) 2002-15 James E. Keenan. United States. All rights reserved.
3175             This is free software and may be distributed under the same terms as Perl
3176             itself.
3177              
3178             =head1 DISCLAIMER OF WARRANTY
3179              
3180             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
3181             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
3182             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
3183             PROVIDE THE SOFTWARE ''AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER
3184             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
3185             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
3186             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
3187             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
3188             NECESSARY SERVICING, REPAIR, OR CORRECTION.
3189              
3190             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
3191             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
3192             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
3193             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
3194             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
3195             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
3196             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
3197             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
3198             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
3199             SUCH DAMAGES.
3200              
3201             =cut
3202