File Coverage

blib/lib/List/Compare.pm
Criterion Covered Total %
statement 1157 1157 100.0
branch 248 248 100.0
condition 81 81 100.0
subroutine 189 189 100.0
pod 23 31 74.1
total 1698 1706 99.5


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