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.54';
3 34     34   2382977 use strict;
  34         354  
  34         1301  
4             local $^W = 1;
5 34     34   195 use Carp;
  34         65  
  34         2418  
6 34         44698 use List::Compare::Base::_Auxiliary qw(
7             _validate_2_seenhashes
8             _chart_engine_regular
9 34     34   18088 );
  34         100  
10              
11             sub new {
12 212     212 1 81450 my $class = shift;
13 212         511 my (@args, $unsorted, $accelerated, $argument_error_status, $nextarg, @testargs);
14 212 100 100     1097 if (@_ == 1 and (ref($_[0]) eq 'HASH')) {
15 89         183 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       139 unless exists ${$argref}{'lists'};
  89         310  
18             die "Need to define 'lists' key properly: $!"
19 88         325 unless ( ${$argref}{'lists'}
20 88 100 100     160 and (ref(${$argref}{'lists'}) eq 'ARRAY') );
  87         344  
21 86         162 @args = @{${$argref}{'lists'}};
  86         136  
  86         247  
22 86 100       139 $unsorted = ${$argref}{'unsorted'} ? 1 : '';
  86         238  
23 86 100       150 $accelerated = ${$argref}{'accelerated'} ? 1 : '';
  86         256  
24             } else {
25 123         323 @args = @_;
26 123 100 100     639 $unsorted = ($args[0] eq '-u' or $args[0] eq '--unsorted')
27             ? shift(@args) : '';
28 123 100 100     612 $accelerated = shift(@args)
29             if ($args[0] eq '-a' or $args[0] eq '--accelerated');
30             }
31 209         369 $argument_error_status = 1;
32 209         651 @testargs = @args[1..$#args];
33 209 100 100     965 if (ref($args[0]) eq 'ARRAY' or ref($args[0]) eq 'HASH') {
34 195         548 while (defined ($nextarg = shift(@testargs))) {
35 339 100       1149 unless (ref($nextarg) eq ref($args[0])) {
36 16         37 $argument_error_status = 0;
37 16         36 last;
38             }
39             }
40             } else {
41 14         50 $argument_error_status = 0;
42             }
43 209 100       3542 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       566 if (@args > 2) {
    100          
48 43 100       113 if ($accelerated) {
49 22         73 $class .= '::Multiple::Accelerated';
50             } else {
51 21         69 $class .= '::Multiple';
52             }
53             } elsif (@args == 2) {
54 129 100       262 if ($accelerated) {
55 61         195 $class .= '::Accelerated';
56             }
57             } else {
58 7         694 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         531 my $self = bless {}, $class;
64 172 100       815 my $dataref = $self->_init(($unsorted ? 1 : 0), @args);
65              
66             # initialize the object from the prepared values (Damian, p. 98)
67 162         1133 %$self = %$dataref;
68 162         907 return $self;
69             }
70              
71             sub _init {
72 68     68   118 my $self = shift;
73 68         138 my ($unsortflag, $refL, $refR) = @_;
74 68         117 my (%data, @left, @right, %seenL, %seenR);
75 68 100       223 if (ref($refL) eq 'HASH') {
76 27         127 my ($seenLref, $seenRref) = _validate_2_seenhashes($refL, $refR);
77 23         47 foreach my $key (keys %{$seenLref}) {
  23         77  
78 116         174 for (my $j=1; $j <= ${$seenLref}{$key}; $j++) {
  255         497  
79 139         234 push(@left, $key);
80             }
81             }
82 23         59 foreach my $key (keys %{$seenRref}) {
  23         72  
83 105         157 for (my $j=1; $j <= ${$seenRref}{$key}; $j++) {
  228         440  
84 123         202 push(@right, $key);
85             }
86             }
87 23         46 %seenL = %{$seenLref};
  23         118  
88 23         48 %seenR = %{$seenRref};
  23         118  
89             } else {
90 41         93 foreach (@$refL) { $seenL{$_}++ }
  160         281  
91 41         81 foreach (@$refR) { $seenR{$_}++ }
  149         235  
92 41         92 @left = @$refL;
93 41         84 @right = @$refR;
94             }
95 64 100       347 my @bag = $unsortflag ? (@left, @right) : sort(@left, @right);
96 64         128 my (%intersection, %union, %Lonly, %Ronly, %LorRonly);
97 64         121 my $LsubsetR_status = my $RsubsetL_status = 1;
98 64         85 my $LequivalentR_status = 0;
99              
100 64         256 foreach (keys %seenL) {
101 252         453 $union{$_}++;
102 252 100       549 exists $seenR{$_} ? $intersection{$_}++ : $Lonly{$_}++;
103             }
104              
105 64         245 foreach (keys %seenR) {
106 235         318 $union{$_}++;
107 235 100       479 $Ronly{$_}++ unless (exists $intersection{$_});
108             }
109              
110 64         241 $LorRonly{$_}++ foreach ( (keys %Lonly), (keys %Ronly) );
111              
112 64 100       193 $LequivalentR_status = 1 if ( (keys %LorRonly) == 0);
113              
114 64         131 foreach (@left) {
115 183 100       345 if (! exists $seenR{$_}) {
116 39         62 $LsubsetR_status = 0;
117 39         77 last;
118             }
119             }
120 64         125 foreach (@right) {
121 222 100       426 if (! exists $seenL{$_}) {
122 32         57 $RsubsetL_status = 0;
123 32         56 last;
124             }
125             }
126              
127 64         153 $data{'seenL'} = \%seenL;
128 64         111 $data{'seenR'} = \%seenR;
129 64 100       268 $data{'intersection'} = $unsortflag ? [ keys %intersection ]
130             : [ sort keys %intersection ];
131 64 100       315 $data{'union'} = $unsortflag ? [ keys %union ]
132             : [ sort keys %union ];
133 64 100       219 $data{'unique'} = $unsortflag ? [ keys %Lonly ]
134             : [ sort keys %Lonly ];
135 64 100       222 $data{'complement'} = $unsortflag ? [ keys %Ronly ]
136             : [ sort keys %Ronly ];
137 64 100       238 $data{'symmetric_difference'} = $unsortflag ? [ keys %LorRonly ]
138             : [ sort keys %LorRonly ];
139 64         190 $data{'LsubsetR_status'} = $LsubsetR_status;
140 64         105 $data{'RsubsetL_status'} = $RsubsetL_status;
141 64         117 $data{'LequivalentR_status'} = $LequivalentR_status;
142 64 100       193 $data{'LdisjointR_status'} = keys %intersection == 0 ? 1 : 0;
143 64         107 $data{'bag'} = \@bag;
144 64         296 return \%data;
145             }
146              
147             sub get_intersection {
148 26     26 1 9600 return @{ get_intersection_ref(shift) };
  26         104  
149             }
150              
151             sub get_intersection_ref {
152 52     52 0 5826 my $class = shift;
153 52         360 my %data = %$class;
154 52         404 return $data{'intersection'};
155             }
156              
157             sub get_union {
158 8     8 1 6545 return @{ get_union_ref(shift) };
  8         33  
159             }
160              
161             sub get_union_ref {
162 16     16 0 6831 my $class = shift;
163 16         109 my %data = %$class;
164 16         94 return $data{'union'};
165             }
166              
167             sub get_shared {
168 8     8 1 21337 my $class = shift;
169 8         59 my $method = (caller(0))[3];
170 8         1742 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         861 get_intersection($class);
172             }
173              
174             sub get_shared_ref {
175 8     8 0 36383 my $class = shift;
176 8         62 my $method = (caller(0))[3];
177 8         889 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         497 get_intersection_ref($class);
179             }
180              
181             sub get_unique {
182 24     24 1 35531 return @{ get_unique_ref(shift) };
  24         84  
183             }
184              
185             sub get_unique_ref {
186 48     48 0 18013 my $class = shift;
187 48         297 my %data = %$class;
188 48         242 return $data{'unique'};
189             }
190              
191             sub get_unique_all {
192 8     8 1 5837 my $class = shift;
193 8         68 my %data = %$class;
194 8         51 return [ $data{'unique'}, $data{'complement'} ];
195             }
196              
197             {
198 34     34   323 no warnings 'once';
  34         80  
  34         7092  
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 18878 return @{ get_complement_ref(shift) };
  24         76  
207             }
208              
209             sub get_complement_ref {
210 48     48 0 17543 my $class = shift;
211 48         283 my %data = %$class;
212 48         216 return $data{'complement'};
213             }
214              
215             sub get_complement_all {
216 8     8 1 5735 my $class = shift;
217 8         64 my %data = %$class;
218 8         45 return [ $data{'complement'}, $data{'unique'} ];
219             }
220              
221             {
222 34     34   309 no warnings 'once';
  34         101  
  34         5321  
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 24063 return @{ get_symmetric_difference_ref(shift) };
  40         158  
231             }
232              
233             sub get_symmetric_difference_ref {
234 80     80 0 23897 my $class = shift;
235 80         469 my %data = %$class;
236 80         516 return $data{'symmetric_difference'};
237             }
238              
239             {
240 34     34   259 no warnings 'once';
  34         77  
  34         9415  
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 14339 my $class = shift;
251 8         59 my $method = (caller(0))[3];
252 8         1077 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         508 get_symmetric_difference($class);
254             }
255              
256             sub get_nonintersection_ref {
257 8     8 1 31199 my $class = shift;
258 8         56 my $method = (caller(0))[3];
259 8         808 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         479 get_symmetric_difference_ref($class);
261             }
262              
263             sub is_LsubsetR {
264 48     48 1 16416 my $class = shift;
265 48         285 my %data = %$class;
266 48         206 return $data{'LsubsetR_status'};
267             }
268              
269 34     34   296 { no warnings 'once'; *is_AsubsetB = \&is_LsubsetR; }
  34         85  
  34         3096  
270              
271             sub is_RsubsetL {
272 48     48 0 13147 my $class = shift;
273 48         277 my %data = %$class;
274 48         196 return $data{'RsubsetL_status'};
275             }
276              
277 34     34   244 { no warnings 'once'; *is_BsubsetA = \&is_RsubsetL; }
  34         65  
  34         2924  
278              
279             sub is_LequivalentR {
280 48     48 1 16340 my $class = shift;
281 48         313 my %data = %$class;
282 48         211 return $data{'LequivalentR_status'};
283             }
284              
285 34     34   226 { no warnings 'once'; *is_LeqvlntR = \&is_LequivalentR; }
  34         88  
  34         30566  
286              
287             sub is_LdisjointR {
288 34     34 1 8244 my $class = shift;
289 34         212 my %data = %$class;
290 34         150 return $data{'LdisjointR_status'};
291             }
292              
293             sub print_subset_chart {
294 8     8 1 11191 my $class = shift;
295 8         69 my %data = %$class;
296 8         119 my @subset_array = ($data{'LsubsetR_status'}, $data{'RsubsetL_status'});
297 8         28 my $title = 'Subset';
298 8         136 _chart_engine_regular(\@subset_array, $title);
299             }
300              
301             sub print_equivalence_chart {
302 8     8 1 27801 my $class = shift;
303 8         74 my %data = %$class;
304             my @equivalent_array = ($data{'LequivalentR_status'},
305 8         42 $data{'LequivalentR_status'});
306 8         20 my $title = 'Equivalence';
307 8         36 _chart_engine_regular(\@equivalent_array, $title);
308             }
309              
310             sub is_member_which {
311 92     92 1 22137 return @{ is_member_which_ref(@_) };
  92         162  
312             }
313              
314             sub is_member_which_ref {
315 185     185 1 8149 my $class = shift;
316 185 100 100     1507 croak "Method call requires exactly 1 argument (no references): $!"
317             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
318 176         672 my %data = %$class;
319 176         335 my $arg = shift;
320 176         261 my @found = ();
321 176 100       279 if (exists ${$data{'seenL'}}{$arg}) { push @found, 0; }
  176         368  
  112         265  
322 176 100       263 if (exists ${$data{'seenR'}}{$arg}) { push @found, 1; }
  176         373  
  112         196  
323 176         574 return \@found;
324             }
325              
326             sub are_members_which {
327 13     13 1 6860 my $class = shift;
328 13 100 100     521 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         70 my %data = %$class;
331 8         28 my (@args, %found);
332 8         18 @args = @{$_[0]};
  8         74  
333 8         47 for (my $i=0; $i<=$#args; $i++) {
334 88         118 @{$found{$args[$i]}} = ();
  88         197  
335 88 100       150 if (exists ${$data{'seenL'}}{$args[$i]}) { push @{$found{$args[$i]}}, 0; }
  88         185  
  56         81  
  56         104  
336 88 100       110 if (exists ${$data{'seenR'}}{$args[$i]}) { push @{$found{$args[$i]}}, 1; }
  88         219  
  56         74  
  56         177  
337             }
338 8         51 return \%found;
339             }
340              
341             sub is_member_any {
342 93     93 1 7508 my $class = shift;
343 93 100 100     708 croak "Method call requires exactly 1 argument (no references): $!"
344             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
345 88         410 my %data = %$class;
346 88         168 my $arg = shift;
347             ( defined $data{'seenL'}{$arg} ) ||
348 88 100 100     487 ( defined $data{'seenR'}{$arg} ) ? return 1 : return 0;
349             }
350              
351             sub are_members_any {
352 13     13 1 6475 my $class = shift;
353 13 100 100     484 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         76 my %data = %$class;
356 8         27 my (@args, %present);
357 8         20 @args = @{$_[0]};
  8         37  
358 8         48 for (my $i=0; $i<=$#args; $i++) {
359             $present{$args[$i]} = ( defined $data{'seenL'}{$args[$i]} ) ||
360 88 100 100     375 ( defined $data{'seenR'}{$args[$i]} ) ? 1 : 0;
361             }
362 8         70 return \%present;
363             }
364              
365             sub get_bag {
366 8     8 1 22557 return @{ get_bag_ref(shift) };
  8         42  
367             }
368              
369             sub get_bag_ref {
370 16     16 0 6856 my $class = shift;
371 16         111 my %data = %$class;
372 16         168 return $data{'bag'};
373             }
374              
375             sub get_version {
376 8     8 1 4373 return $List::Compare::VERSION;
377             }
378              
379             1;
380              
381             ################################################################################
382              
383             package List::Compare::Accelerated;
384 34     34   285 use Carp;
  34         80  
  34         2349  
385 34         21841 use List::Compare::Base::_Auxiliary qw(
386             _argument_checker_0
387             _chart_engine_regular
388             _calc_seen
389             _equiv_engine
390 34     34   260 );
  34         87  
391              
392             sub _init {
393 61     61   100 my $self = shift;
394 61         121 my ($unsortflag, $refL, $refR) = @_;
395 61         103 my %data = ();
396 61         175 ($data{'L'}, $data{'R'}) = _argument_checker_0($refL, $refR);
397 57 100       151 $data{'unsort'} = $unsortflag ? 1 : 0;
398 57         124 return \%data;
399             }
400              
401             sub get_intersection {
402 14     14   23594 return @{ get_intersection_ref(shift) };
  14         56  
403             }
404              
405             sub get_intersection_ref {
406 28     28   5909 my $class = shift;
407 28         111 my %data = %$class;
408             $data{'unsort'}
409             ? return _intersection_engine($data{'L'}, $data{'R'})
410 28 100       140 : return [ sort @{_intersection_engine($data{'L'}, $data{'R'})} ];
  16         52  
411             }
412              
413             sub get_union {
414 8     8   4186 return @{ get_union_ref(shift) };
  8         38  
415             }
416              
417             sub get_union_ref {
418 32     32   6435 my $class = shift;
419 32         130 my %data = %$class;
420             $data{'unsort'}
421             ? return _union_engine($data{'L'}, $data{'R'})
422 32 100       141 : return [ sort @{_union_engine($data{'L'}, $data{'R'})} ];
  16         49  
423             }
424              
425             sub get_shared {
426 8     8   16758 return @{ get_shared_ref(shift) };
  8         39  
427             }
428              
429             sub get_shared_ref {
430 16     16   54866 my $class = shift;
431 16         149 my $method = (caller(0))[3];
432 16         136 $method =~ s/.*::(\w*)$/$1/;
433 16         2321 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         1169 &get_union_ref($class);
435             }
436              
437             sub get_unique {
438 24     24   16879 return @{ get_unique_ref(shift) };
  24         67  
439             }
440              
441             sub get_unique_ref {
442 64     64   16554 my $class = shift;
443 64         214 my %data = %$class;
444             $data{'unsort'}
445             ? return _unique_engine($data{'L'}, $data{'R'})
446 64 100       218 : return [ sort @{_unique_engine($data{'L'}, $data{'R'})} ];
  32         78  
447             }
448              
449             sub get_unique_all {
450 8     8   5382 my $class = shift;
451 8         31 return [ get_unique_ref($class), get_complement_ref($class) ];
452             }
453              
454             {
455 34     34   297 no warnings 'once';
  34         76  
  34         7349  
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   17964 return @{ get_complement_ref(shift) };
  24         109  
464             }
465              
466             sub get_complement_ref {
467 64     64   16660 my $class = shift;
468 64         214 my %data = %$class;
469             $data{'unsort'}
470             ? return _complement_engine($data{'L'}, $data{'R'})
471 64 100       212 : return [ sort @{_complement_engine($data{'L'}, $data{'R'})} ];
  32         90  
472             }
473              
474             sub get_complement_all {
475 8     8   5443 my $class = shift;
476 8         31 return [ get_complement_ref($class), get_unique_ref($class) ];
477             }
478              
479             {
480 34     34   250 no warnings 'once';
  34         72  
  34         6241  
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   23577 return @{ get_symmetric_difference_ref(shift) };
  32         86  
489             }
490              
491             sub get_symmetric_difference_ref {
492 80     80   22002 my $class = shift;
493 80         305 my %data = %$class;
494             $data{'unsort'}
495             ? return _symmetric_difference_engine($data{'L'}, $data{'R'})
496 80 100       266 : return [ sort @{_symmetric_difference_engine($data{'L'}, $data{'R'})} ];
  40         98  
497             }
498              
499             {
500 34     34   283 no warnings 'once';
  34         114  
  34         8017  
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   14462 return @{ get_nonintersection_ref(shift) };
  8         53  
511             }
512              
513             sub get_nonintersection_ref {
514 16     16   30383 my $class = shift;
515 16         101 my $method = (caller(0))[3];
516 16         150 $method =~ s/.*::(\w*)$/$1/;
517 16         2079 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         967 &get_symmetric_difference_ref($class);
519             }
520              
521             sub is_LsubsetR {
522 38     38   14403 my $class = shift;
523 38         195 my %data = %$class;
524 38         129 return _is_LsubsetR_engine($data{'L'}, $data{'R'});
525             }
526              
527 34     34   248 { no warnings 'once'; *is_AsubsetB = \&is_LsubsetR; }
  34         61  
  34         3381  
528              
529             sub is_RsubsetL {
530 38     38   11251 my $class = shift;
531 38         149 my %data = %$class;
532 38         135 return _is_RsubsetL_engine($data{'L'}, $data{'R'});
533             }
534              
535 34     34   248 { no warnings 'once'; *is_BsubsetA = \&is_RsubsetL; }
  34         67  
  34         3038  
536              
537             sub is_LequivalentR {
538 48     48   14603 my $class = shift;
539 48         186 my %data = %$class;
540 48         146 return _is_LequivalentR_engine($data{'L'}, $data{'R'});
541             }
542              
543 34     34   240 { no warnings 'once'; *is_LeqvlntR = \&is_LequivalentR; }
  34         80  
  34         77592  
544              
545             sub is_LdisjointR {
546 30     30   7091 my $class = shift;
547 30         122 my %data = %$class;
548 30         115 return _is_LdisjointR_engine($data{'L'}, $data{'R'});
549             }
550              
551             sub print_subset_chart {
552 8     8   10539 my $class = shift;
553 8         42 my %data = %$class;
554 8         48 _print_subset_chart_engine($data{'L'}, $data{'R'});
555             }
556              
557             sub print_equivalence_chart {
558 8     8   25444 my $class = shift;
559 8         47 my %data = %$class;
560 8         45 _print_equivalence_chart_engine($data{'L'}, $data{'R'});
561             }
562              
563             sub is_member_which {
564 92     92   20857 return @{ is_member_which_ref(@_) };
  92         178  
565             }
566              
567             sub is_member_which_ref {
568 185     185   7418 my $class = shift;
569 185 100 100     1469 croak "Method call requires exactly 1 argument (no references): $!"
570             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
571 176         411 my %data = %$class;
572 176         361 return _is_member_which_engine($data{'L'}, $data{'R'}, shift);
573             }
574              
575             sub are_members_which {
576 13     13   6245 my $class = shift;
577 13 100 100     462 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         45 my %data = %$class;
580 8         20 my (@args);
581 8         20 @args = @{$_[0]};
  8         33  
582 8         38 return _are_members_which_engine($data{'L'}, $data{'R'}, \@args);
583             }
584              
585             sub is_member_any {
586 93     93   6759 my $class = shift;
587 93 100 100     681 croak "Method call requires exactly 1 argument (no references): $!"
588             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
589 88         199 my %data = %$class;
590 88         199 return _is_member_any_engine($data{'L'}, $data{'R'}, shift);
591             }
592              
593             sub are_members_any {
594 13     13   6021 my $class = shift;
595 13 100 100     465 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         40 my %data = %$class;
598 8         24 my (@args);
599 8         18 @args = @{$_[0]};
  8         31  
600 8         53 return _are_members_any_engine($data{'L'}, $data{'R'}, \@args);
601             }
602              
603             sub get_bag {
604 8     8   21059 return @{ get_bag_ref(shift) };
  8         38  
605             }
606              
607             sub get_bag_ref {
608 16     16   6213 my $class = shift;
609 16         121 my %data = %$class;
610 16 100       80 if (ref($data{'L'}) eq 'ARRAY') {
611 4         10 $data{'unsort'} ? return [ @{$data{'L'}}, @{$data{'R'}} ]
  4         29  
612 8 100       27 : return [ sort(@{$data{'L'}}, @{$data{'R'}}) ];
  4         8  
  4         43  
613             } else {
614 8         22 my (@left, @right);
615 8         14 foreach my $key (keys %{$data{'L'}}) {
  8         32  
616 56         122 for (my $j=1; $j <= ${$data{'L'}}{$key}; $j++) {
  120         242  
617 64         109 push(@left, $key);
618             }
619             }
620 8         55 foreach my $key (keys %{$data{'R'}}) {
  8         28  
621 56         142 for (my $j=1; $j <= ${$data{'R'}}{$key}; $j++) {
  120         230  
622 64         105 push(@right, $key);
623             }
624             }
625 8 100       137 $data{'unsort'} ? return [ @left, @right ]
626             : return [ sort(@left, @right) ];
627             }
628             }
629              
630             sub get_version {
631 8     8   4203 return $List::Compare::VERSION;
632             }
633              
634             sub _intersection_engine {
635 28     28   67 my ($l, $r) = @_;
636 28         91 my ($hrefL, $hrefR) = _calc_seen($l, $r);
637 28         73 my %intersection = ();
638 28         49 foreach (keys %{$hrefL}) {
  28         100  
639 160 100       189 $intersection{$_}++ if (exists ${$hrefR}{$_});
  160         358  
640             }
641 28         262 return [ keys %intersection ];
642             }
643              
644             sub _union_engine {
645 32     32   76 my ($l, $r) = @_;
646 32         104 my ($hrefL, $hrefR) = _calc_seen($l, $r);
647 32         62 my %union = ();
648 32         62 $union{$_}++ foreach ( (keys %{$hrefL}), (keys %{$hrefR}) );
  32         94  
  32         230  
649 32         406 return [ keys %union ];
650             }
651              
652             sub _unique_engine {
653 64     64   117 my ($l, $r) = @_;
654 64         176 my ($hrefL, $hrefR) = _calc_seen($l, $r);
655 64         113 my (%Lonly);
656 64         83 foreach (keys %{$hrefL}) {
  64         196  
657 448 100       508 $Lonly{$_}++ unless exists ${$hrefR}{$_};
  448         887  
658             }
659 64         425 return [ keys %Lonly ];
660             }
661              
662             sub _complement_engine {
663 64     64   114 my ($l, $r) = @_;
664 64         173 my ($hrefL, $hrefR) = _calc_seen($l, $r);
665 64         108 my (%Ronly);
666 64         85 foreach (keys %{$hrefR}) {
  64         195  
667 448 100       546 $Ronly{$_}++ unless (exists ${$hrefL}{$_});
  448         859  
668             }
669 64         433 return [ keys %Ronly ];
670             }
671              
672             sub _symmetric_difference_engine {
673 80     80   148 my ($l, $r) = @_;
674 80         237 my ($hrefL, $hrefR) = _calc_seen($l, $r);
675 80         144 my (%LorRonly);
676 80         114 foreach (keys %{$hrefL}) {
  80         238  
677 560 100       664 $LorRonly{$_}++ unless (exists ${$hrefR}{$_});
  560         1141  
678             }
679 80         131 foreach (keys %{$hrefR}) {
  80         208  
680 560 100       632 $LorRonly{$_}++ unless (exists ${$hrefL}{$_});
  560         1002  
681             }
682 80         646 return [ keys %LorRonly ];
683             }
684              
685             sub _is_LsubsetR_engine {
686 38     38   83 my ($l, $r) = @_;
687 38         222 my ($hrefL, $hrefR) = _calc_seen($l, $r);
688 38         67 my $LsubsetR_status = 1;
689 38         68 foreach (keys %{$hrefL}) {
  38         124  
690 128 100       163 if (! exists ${$hrefR}{$_}) {
  128         374  
691 32         49 $LsubsetR_status = 0;
692 32         97 last;
693             }
694             }
695 38         161 return $LsubsetR_status;
696             }
697              
698             sub _is_RsubsetL_engine {
699 38     38   113 my ($l, $r) = @_;
700 38         110 my ($hrefL, $hrefR) = _calc_seen($l, $r);
701 38         121 my $RsubsetL_status = 1;
702 38         69 foreach (keys %{$hrefR}) {
  38         152  
703 129 100       189 if (! exists ${$hrefL}{$_}) {
  129         284  
704 22         35 $RsubsetL_status = 0;
705 22         54 last;
706             }
707             }
708 38         149 return $RsubsetL_status;
709             }
710              
711             sub _is_LequivalentR_engine {
712 48     48   95 my ($l, $r) = @_;
713 48         160 my ($hrefL, $hrefR) = _calc_seen($l, $r);
714 48         134 return _equiv_engine($hrefL, $hrefR);
715             }
716              
717             sub _is_LdisjointR_engine {
718 30     30   64 my ($l, $r) = @_;
719 30         93 my ($hrefL, $hrefR) = _calc_seen($l, $r);
720 30         76 my %intersection = ();
721 30         62 foreach (keys %{$hrefL}) {
  30         92  
722 152 100       189 $intersection{$_}++ if (exists ${$hrefR}{$_});
  152         345  
723             }
724 30 100       221 keys %intersection == 0 ? 1 : 0;
725             }
726              
727             sub _print_subset_chart_engine {
728 8     8   32 my ($l, $r) = @_;
729 8         34 my ($hrefL, $hrefR) = _calc_seen($l, $r);
730 8         35 my $LsubsetR_status = my $RsubsetL_status = 1;
731 8         19 foreach (keys %{$hrefL}) {
  8         58  
732 40 100       50 if (! exists ${$hrefR}{$_}) {
  40         102  
733 8         30 $LsubsetR_status = 0;
734 8         21 last;
735             }
736             }
737 8         21 foreach (keys %{$hrefR}) {
  8         30  
738 31 100       44 if (! exists ${$hrefL}{$_}) {
  31         66  
739 8         14 $RsubsetL_status = 0;
740 8         28 last;
741             }
742             }
743 8         38 my @subset_array = ($LsubsetR_status, $RsubsetL_status);
744 8         25 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         32 my ($hrefL, $hrefR) = _calc_seen($l, $r);
751 8         33 my $LequivalentR_status = _equiv_engine($hrefL, $hrefR);
752 8         32 my @equivalent_array = ($LequivalentR_status, $LequivalentR_status);
753 8         19 my $title = 'Equivalence';
754 8         30 _chart_engine_regular(\@equivalent_array, $title);
755             }
756              
757             sub _is_member_which_engine {
758 176     176   279 my ($l, $r, $arg) = @_;
759 176         337 my ($hrefL, $hrefR) = _calc_seen($l, $r);
760 176         259 my @found = ();
761 176 100       213 if (exists ${$hrefL}{$arg}) { push @found, 0; }
  176         374  
  112         185  
762 176 100       229 if (exists ${$hrefR}{$arg}) { push @found, 1; }
  176         298  
  112         157  
763 176         656 return \@found;
764             }
765              
766             sub _are_members_which_engine {
767 8     8   25 my ($l, $r, $arg) = @_;
768 8         32 my ($hrefL, $hrefR) = _calc_seen($l, $r);
769 8         20 my @args = @{$arg};
  8         30  
770 8         18 my (%found);
771 8         36 for (my $i=0; $i<=$#args; $i++) {
772 88         116 @{$found{$args[$i]}} = ();
  88         178  
773 88 100       115 if (exists ${$hrefL}{$args[$i]}) { push @{$found{$args[$i]}}, 0; }
  88         175  
  56         85  
  56         104  
774 88 100       114 if (exists ${$hrefR}{$args[$i]}) { push @{$found{$args[$i]}}, 1; }
  88         194  
  56         70  
  56         118  
775             }
776 8         45 return \%found;
777             }
778              
779             sub _is_member_any_engine {
780 88     88   146 my ($l, $r, $arg) = @_;
781 88         174 my ($hrefL, $hrefR) = _calc_seen($l, $r);
782             ( defined ${$hrefL}{$arg} ) ||
783 88 100 100     123 ( defined ${$hrefR}{$arg} ) ? return 1 : return 0;
784             }
785              
786             sub _are_members_any_engine {
787 8     8   26 my ($l, $r, $arg) = @_;
788 8         35 my ($hrefL, $hrefR) = _calc_seen($l, $r);
789 8         21 my @args = @{$arg};
  8         31  
790 8         17 my (%present);
791 8         36 for (my $i=0; $i<=$#args; $i++) {
792             $present{$args[$i]} = ( defined ${$hrefL}{$args[$i]} ) ||
793 88 100 100     111 ( defined ${$hrefR}{$args[$i]} ) ? 1 : 0;
794             }
795 8         65 return \%present;
796             }
797              
798             1;
799              
800             ################################################################################
801              
802             package List::Compare::Multiple;
803 34     34   297 use Carp;
  34         705  
  34         2443  
804 34         60412 use List::Compare::Base::_Auxiliary qw(
805             _validate_seen_hash
806             _index_message1
807             _index_message2
808             _chart_engine_multiple
809 34     34   247 );
  34         60  
810              
811             sub _init {
812 21     21   48 my $self = shift;
813 21         37 my $unsortflag = shift;
814 21         56 my @listrefs = @_;
815 21         46 my (@arrayrefs);
816 21         45 my $maxindex = $#listrefs;
817 21 100       78 if (ref($listrefs[0]) eq 'ARRAY') {
818 10         28 @arrayrefs = @listrefs;
819             } else {
820 11         55 _validate_seen_hash(@listrefs);
821 9         33 foreach my $href (@listrefs) {
822 49         68 my (@temp);
823 49         76 foreach my $key (keys %{$href}) {
  49         116  
824 255         333 for (my $j=1; $j <= ${$href}{$key}; $j++) {
  555         977  
825 300         526 push(@temp, $key);
826             }
827             }
828 49         114 push(@arrayrefs, \@temp);
829             }
830             }
831              
832 19         44 my @bag = ();
833 19         55 foreach my $aref (@arrayrefs) {
834 101         415 push @bag, $_ foreach @$aref;
835             }
836 19 100       172 @bag = sort(@bag) unless $unsortflag;
837              
838 19         41 my (@intersection, @union);
839             # will hold overall intersection/union
840 19         44 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         35 my (%intersection, %union);
850             # will be used to generate @intersection & @union
851 19         50 my %seen = ();
852             # will be hash of hashes, holding seen-hashes corresponding to
853             # the source lists
854 19         35 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         39 my %shared = ();
859             # will be used to generate @shared
860 19         41 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         61 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         48 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         74 for (my $i = 0; $i <= $#arrayrefs; $i++) {
874 101         175 my %seenthis = ();
875 101         160 foreach (@{$arrayrefs[$i]}) {
  101         183  
876 606         858 $seenthis{$_}++;
877 606         816 $union{$_}++;
878             }
879 101         265 $seen{$i} = \%seenthis;
880 101         282 for (my $j = $i+1; $j <=$#arrayrefs; $j++) {
881 223         313 my (%seenthat, %seenintersect);
882 223         377 my $ilabel = $i . '_' . $j;
883 223         300 $seenthat{$_}++ foreach (@{$arrayrefs[$j]});
  223         676  
884 223         525 foreach (keys %seenthat) {
885 938 100       1705 $seenintersect{$_}++ if (exists $seenthis{$_});
886             }
887 223         924 $xintersection{$ilabel} = \%seenintersect;
888             }
889             }
890 19 100       180 @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         131 my @xkeys = keys %xintersection;
898 19         47 %intersection = %{$xintersection{$xkeys[0]}};
  19         91  
899 19         90 for (my $m = 1; $m <= $#xkeys; $m++) {
900 204         283 my %compare = %{$xintersection{$xkeys[$m]}};
  204         596  
901 204         301 my %result = ();
902 204         382 foreach (keys %compare) {
903 548 100       927 $result{$_}++ if (exists $intersection{$_});
904             }
905 204         572 %intersection = %result;
906             }
907 19 100       93 @intersection = $unsortflag ? keys %intersection : sort(keys %intersection);
908              
909             # Calculate nonintersection
910             # Inputs: @union %intersection
911 19         54 foreach (@union) {
912 207 100       424 push(@nonintersection, $_) unless (exists $intersection{$_});
913             }
914              
915             # Calculate @xunique and @xdisjoint
916             # Inputs: @arrayrefs %seen %xintersection
917 19         100 for (my $i = 0; $i <= $#arrayrefs; $i++) {
918 101         158 my %seenthis = %{$seen{$i}};
  101         428  
919 101         207 my (@uniquethis, %deductions, %alldeductions);
920             # Get those elements of %xintersection which we'll need
921             # to subtract from %seenthis
922 101         287 foreach (keys %xintersection) {
923 1229         2546 my ($left, $right) = split /_/, $_;
924 1229 100 100     3363 if ($left == $i || $right == $i) {
925 446         636 $deductions{$_} = $xintersection{$_};
926             }
927             $xdisjoint[$left][$right] = $xdisjoint[$right][$left] =
928 1229 100       1403 ! (keys %{$xintersection{$_}}) ? 1 : 0;
  1229         2860  
929             }
930 101         281 foreach my $ded (keys %deductions) {
931 446         527 foreach (keys %{$deductions{$ded}}) {
  446         771  
932 1196         1754 $alldeductions{$_}++;
933             }
934             }
935 101         261 foreach (keys %seenthis) {
936 516 100       927 push(@uniquethis, $_) unless ($alldeductions{$_});
937             }
938 101         192 $xunique[$i] = \@uniquethis;
939 101         349 $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         91 for (my $i = 0; $i <= $#arrayrefs; $i++) {
947 101         126 my %seenthis = %{$seen{$i}};
  101         328  
948 101         164 my @complementthis = ();
949 101         163 foreach (@union) {
950 1133 100       1957 push(@complementthis, $_) unless (exists $seenthis{$_});
951             }
952 101         282 $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         108 foreach my $q (keys %xintersection) {
961 223         268 $shared{$_}++ foreach (keys %{$xintersection{$q}});
  223         599  
962             }
963 19 100       154 @shared = $unsortflag ? keys %shared : sort(keys %shared);
964 19         59 foreach (@union) {
965 207 100       410 push(@symmetric_difference, $_) unless (exists $shared{$_});
966             }
967             # @shared and @symmetric_difference are now available.
968              
969 19         59 my @xsubset = ();
970 19         82 foreach my $i (keys %seen) {
971 101         133 my %tempi = %{$seen{$i}};
  101         285  
972 101         232 foreach my $j (keys %seen) {
973 547         678 my %tempj = %{$seen{$j}};
  547         1406  
974 547         990 $xsubset[$i][$j] = 1;
975 547         1049 foreach (keys %tempi) {
976 2808 100       5652 $xsubset[$i][$j] = 0 if (! $tempj{$_});
977             }
978             }
979             }
980             # @xsubset is now available
981              
982 19         53 my @xequivalent = ();
983 19         79 for (my $f = 0; $f <= $#xsubset; $f++) {
984 101         198 for (my $g = 0; $g <= $#xsubset; $g++) {
985 547         726 $xequivalent[$f][$g] = 0;
986 547 100 100     1385 $xequivalent[$f][$g] = 1
987             if ($xsubset[$f][$g] and $xsubset[$g][$f]);
988             }
989             }
990              
991 19         65 my (%data);
992 19         52 $data{'seen'} = \%seen;
993 19         44 $data{'maxindex'} = $maxindex;
994 19         58 $data{'intersection'} = \@intersection;
995 19         43 $data{'nonintersection'} = \@nonintersection;
996 19         45 $data{'union'} = \@union;
997 19         43 $data{'shared'} = \@shared;
998 19         73 $data{'symmetric_difference'} = \@symmetric_difference;
999 19         48 $data{'xunique'} = \@xunique;
1000 19         41 $data{'xcomplement'} = \@xcomplement;
1001 19         47 $data{'xsubset'} = \@xsubset;
1002 19         44 $data{'xequivalent'} = \@xequivalent;
1003 19         53 $data{'xdisjoint'} = \@xdisjoint;
1004 19         134 $data{'bag'} = \@bag;
1005 19         261 return \%data;
1006             }
1007              
1008             sub get_intersection {
1009 8     8   5625 return @{ get_intersection_ref(shift) };
  8         39  
1010             }
1011              
1012             sub get_intersection_ref {
1013 16     16   5279 my $class = shift;
1014 16         194 my %data = %$class;
1015 16         91 return $data{'intersection'};
1016             }
1017              
1018             sub get_union {
1019 8     8   4171 return @{ get_union_ref(shift) };
  8         29  
1020             }
1021              
1022             sub get_union_ref {
1023 16     16   6453 my $class = shift;
1024 16         197 my %data = %$class;
1025 16         95 return $data{'union'};
1026             }
1027              
1028             sub get_shared {
1029 8     8   5862 return @{ get_shared_ref(shift) };
  8         133  
1030             }
1031              
1032             sub get_shared_ref {
1033 16     16   5591 my $class = shift;
1034 16         148 my %data = %$class;
1035 16         87 return $data{'shared'};
1036             }
1037              
1038             sub get_unique {
1039 36     36   15719 my $class = shift;
1040 36         277 my %data = %$class;
1041 36 100       145 my $index = defined $_[0] ? shift : 0;
1042 36         56 return @{ get_unique_ref($class, $index) };
  36         87  
1043             }
1044              
1045             sub get_unique_ref {
1046 77     77   10010 my $class = shift;
1047 77         435 my %data = %$class;
1048 77 100       342 my $index = defined $_[0] ? shift : 0;
1049 77         310 _index_message1($index, \%data);
1050 72         122 return ${$data{'xunique'}}[$index];
  72         564  
1051             }
1052              
1053             sub get_unique_all {
1054 8     8   20479 my $class = shift;
1055 8         73 my %data = %$class;
1056 8         42 return $data{'xunique'};
1057             }
1058              
1059             sub get_Lonly {
1060 24     24   69247 my ($class, $index) = @_;
1061 24         179 my $method = (caller(0))[3];
1062 24         285 $method =~ s/.*::(\w*)$/$1/;
1063 24         2642 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         1835 get_unique($class, $index);
1065             }
1066              
1067             sub get_Lonly_ref {
1068 24     24   144244 my ($class, $index) = @_;
1069 24         154 my $method = (caller(0))[3];
1070 24         231 $method =~ s/.*::(\w*)$/$1/;
1071 24         2267 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         1501 get_unique_ref($class, $index);
1073             }
1074              
1075             {
1076 34     34   306 no warnings 'once';
  34         73  
  34         15209  
1077             *get_Aonly = \&get_Lonly;
1078             *get_Aonly_ref = \&get_Lonly_ref;
1079             }
1080              
1081             sub get_complement {
1082 44     44   31737 my $class = shift;
1083 44         319 my %data = %$class;
1084 44 100       179 my $index = defined $_[0] ? shift : 0;
1085 44         73 return @{ get_complement_ref($class, $index) };
  44         102  
1086             }
1087              
1088             sub get_complement_ref {
1089 93     93   14002 my $class = shift;
1090 93         522 my %data = %$class;
1091 93 100       277 my $index = defined $_[0] ? shift : 0;
1092 93         338 _index_message1($index, \%data);
1093 88         149 return ${$data{'xcomplement'}}[$index];
  88         767  
1094             }
1095              
1096             sub get_complement_all {
1097 8     8   17937 my $class = shift;
1098 8         71 my %data = %$class;
1099 8         42 return $data{'xcomplement'};
1100             }
1101              
1102             sub get_Ronly {
1103 28     28   69830 my ($class, $index) = @_;
1104 28         181 my $method = (caller(0))[3];
1105 28         236 $method =~ s/.*::(\w*)$/$1/;
1106 28         2540 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         1943 &get_complement($class, $index);
1108             }
1109              
1110             sub get_Ronly_ref {
1111 28     28   99095 my ($class, $index) = @_;
1112 28         186 my $method = (caller(0))[3];
1113 28         251 $method =~ s/.*::(\w*)$/$1/;
1114 28         2477 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         1604 &get_complement_ref($class, $index);
1116             }
1117              
1118             {
1119 34     34   311 no warnings 'once';
  34         107  
  34         4679  
1120             *get_Bonly = \&get_Ronly;
1121             *get_Bonly_ref = \&get_Ronly_ref;
1122             }
1123              
1124             sub get_symmetric_difference {
1125 32     32   21442 return @{ get_symmetric_difference_ref(shift) };
  32         94  
1126             }
1127              
1128             sub get_symmetric_difference_ref {
1129 64     64   10665 my $class = shift;
1130 64         431 my %data = %$class;
1131 64         418 return $data{'symmetric_difference'};
1132             }
1133              
1134             {
1135 34     34   291 no warnings 'once';
  34         94  
  34         7849  
1136             *get_symdiff = \&get_symmetric_difference;
1137             *get_symdiff_ref = \&get_symmetric_difference_ref;
1138             }
1139              
1140             sub get_LorRonly {
1141 16     16   38845 my $class = shift;
1142 16         105 my $method = (caller(0))[3];
1143 16         134 $method =~ s/.*::(\w*)$/$1/;
1144 16         1539 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         932 get_symmetric_difference($class);
1146             }
1147              
1148             sub get_LorRonly_ref {
1149 16     16   74979 my $class = shift;
1150 16         113 my $method = (caller(0))[3];
1151 16         165 $method =~ s/.*::(\w*)$/$1/;
1152 16         1545 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         871 get_symmetric_difference_ref($class);
1154             }
1155              
1156             {
1157 34     34   277 no warnings 'once';
  34         88  
  34         7374  
1158             *get_AorBonly = \&get_LorRonly;
1159             *get_AorBonly_ref = \&get_LorRonly_ref;
1160             }
1161              
1162             sub get_nonintersection {
1163 8     8   16326 return @{ get_nonintersection_ref(shift) };
  8         41  
1164             }
1165              
1166             sub get_nonintersection_ref {
1167 16     16   5693 my $class = shift;
1168 16         115 my %data = %$class;
1169 16         109 return $data{'nonintersection'};
1170             }
1171              
1172             sub is_LsubsetR {
1173 57     57   22071 my $class = shift;
1174 57         380 my %data = %$class;
1175 57         243 my ($index_left, $index_right) = _index_message2(\%data, @_);
1176 48         91 my @subset_array = @{$data{'xsubset'}};
  48         127  
1177 48         100 my $subset_status = $subset_array[$index_left][$index_right];
1178 48         180 return $subset_status;
1179             }
1180              
1181 34     34   292 { no warnings 'once'; *is_AsubsetB = \&is_LsubsetR; }
  34         92  
  34         6743  
1182              
1183             sub is_RsubsetL {
1184 16     16   36897 my $class = shift;
1185 16         132 my %data = %$class;
1186 16         109 my $method = (caller(0))[3];
1187 16         138 $method =~ s/.*::(\w*)$/$1/;
1188 16         1474 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         1106 @_ = (1,0);
1190 16         86 my ($index_left, $index_right) = _index_message2(\%data, @_);
1191 16         46 my @subset_array = @{$data{'xsubset'}};
  16         55  
1192 16         40 my $subset_status = $subset_array[$index_left][$index_right];
1193 16         112 return $subset_status;
1194             }
1195              
1196 34     34   250 { no warnings 'once'; *is_BsubsetA = \&is_RsubsetL; }
  34         94  
  34         4348  
1197              
1198             sub is_LequivalentR {
1199 33     33   26045 my $class = shift;
1200 33         239 my %data = %$class;
1201 33         138 my ($index_left, $index_right) = _index_message2(\%data, @_);
1202 24         136 my @equivalent_array = @{$data{'xequivalent'}};
  24         87  
1203 24         55 my $equivalent_status = $equivalent_array[$index_left][$index_right];
1204 24         95 return $equivalent_status;
1205             }
1206              
1207 34     34   236 { no warnings 'once'; *is_LeqvlntR = \&is_LequivalentR; }
  34         81  
  34         32685  
1208              
1209             sub is_LdisjointR {
1210 29     29   9140 my $class = shift;
1211 29         208 my %data = %$class;
1212 29         133 my ($index_left, $index_right) = _index_message2(\%data, @_);
1213 24         53 my @disjoint_array = @{$data{'xdisjoint'}};
  24         90  
1214 24         59 my $disjoint_status = $disjoint_array[$index_left][$index_right];
1215 24         102 return $disjoint_status;
1216             }
1217              
1218             sub is_member_which {
1219 92     92   27355 return @{ is_member_which_ref(@_) };
  92         180  
1220             }
1221              
1222             sub is_member_which_ref {
1223 185     185   21817 my $class = shift;
1224 185 100 100     1503 croak "Method call requires exactly 1 argument (no references): $!"
1225             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1226 176         734 my %data = %$class;
1227 176         362 my %seen = %{$data{'seen'}};
  176         479  
1228 176         280 my ($arg, @found);
1229 176         373 $arg = shift;
1230 176         543 foreach (sort keys %seen) {
1231 880 100       1858 push @found, $_ if (exists $seen{$_}{$arg});
1232             }
1233 176         783 return \@found;
1234             }
1235              
1236             sub are_members_which {
1237 13     13   21564 my $class = shift;
1238 13 100 100     476 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         76 my %data = %$class;
1241 8         29 my %seen = %{$data{'seen'}};
  8         40  
1242 8         27 my (@args, %found);
1243 8         18 @args = @{$_[0]};
  8         32  
1244 8         57 for (my $i=0; $i<=$#args; $i++) {
1245 88         128 my (@not_found);
1246 88         230 foreach (sort keys %seen) {
1247 440         835 exists ${$seen{$_}}{$args[$i]}
1248 440 100       519 ? push @{$found{$args[$i]}}, $_
  216         472  
1249             : push @not_found, $_;
1250             }
1251 88 100       290 $found{$args[$i]} = [] if (@not_found == keys %seen);
1252             }
1253 8         49 return \%found;
1254             }
1255              
1256             sub is_member_any {
1257 93     93   14942 my $class = shift;
1258 93 100 100     731 croak "Method call requires exactly 1 argument (no references): $!"
1259             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1260 88         460 my %data = %$class;
1261 88         156 my %seen = %{$data{'seen'}};
  88         232  
1262 88         138 my ($arg, $k);
1263 88         146 $arg = shift;
1264 88         180 while ( $k = each %seen ) {
1265 185 100       607 return 1 if (defined $seen{$k}{$arg});
1266             }
1267 8         36 return 0;
1268             }
1269              
1270             sub are_members_any {
1271 13     13   7088 my $class = shift;
1272 13 100 100     490 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         99 my %data = %$class;
1275 8         28 my %seen = %{$data{'seen'}};
  8         43  
1276 8         22 my (@args, %present);
1277 8         20 @args = @{$_[0]};
  8         34  
1278 8         54 for (my $i=0; $i<=$#args; $i++) {
1279 88         170 foreach (keys %seen) {
1280 440 100       776 unless (defined $present{$args[$i]}) {
1281 163 100       398 $present{$args[$i]} = 1 if $seen{$_}{$args[$i]};
1282             }
1283             }
1284 88 100       250 $present{$args[$i]} = 0 if (! defined $present{$args[$i]});
1285             }
1286 8         89 return \%present;
1287             }
1288              
1289             sub print_subset_chart {
1290 8     8   11604 my $class = shift;
1291 8         79 my %data = %$class;
1292 8         31 my @subset_array = @{$data{'xsubset'}};
  8         38  
1293 8         30 my $title = 'Subset';
1294 8         57 _chart_engine_multiple(\@subset_array, $title);
1295             }
1296              
1297             sub print_equivalence_chart {
1298 8     8   25634 my $class = shift;
1299 8         81 my %data = %$class;
1300 8         30 my @equivalent_array = @{$data{'xequivalent'}};
  8         40  
1301 8         19 my $title = 'Equivalence';
1302 8         39 _chart_engine_multiple(\@equivalent_array, $title);
1303             }
1304              
1305             sub get_bag {
1306 8     8   5812 return @{ get_bag_ref(shift) };
  8         37  
1307             }
1308              
1309             sub get_bag_ref {
1310 16     16   6463 my $class = shift;
1311 16         118 my %data = %$class;
1312 16         140 return $data{'bag'};
1313             }
1314              
1315             sub get_version {
1316 8     8   4842 return $List::Compare::VERSION;
1317             }
1318              
1319             1;
1320              
1321             ################################################################################
1322              
1323             package List::Compare::Multiple::Accelerated;
1324 34     34   305 use Carp;
  34         79  
  34         2518  
1325 34         2607 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   238 );
  34         99  
1335 34     34   232 use List::Compare::Base::_Auxiliary qw(:calculate);
  34         60  
  34         6056  
1336 34         27018 use List::Compare::Base::_Engine qw(
1337             _unique_all_engine
1338             _complement_all_engine
1339 34     34   18110 );
  34         86  
1340              
1341             sub _init {
1342 22     22   45 my $self = shift;
1343 22         41 my $unsortflag = shift;
1344 22         97 my @listrefs = _argument_checker_0(@_);
1345 22         64 my %data = ();
1346 22         80 for (my $i=0; $i<=$#listrefs; $i++) {
1347 118         311 $data{$i} = $listrefs[$i];
1348             }
1349 22 100       96 $data{'unsort'} = $unsortflag ? 1 : 0;
1350 22         62 return \%data;
1351             }
1352              
1353             sub get_union {
1354 8     8   4147 return @{ get_union_ref(shift) };
  8         33  
1355             }
1356              
1357             sub get_union_ref {
1358 16     16   6589 my $class = shift;
1359 16         81 my %data = %$class;
1360 16         53 my $unsortflag = $data{'unsort'};
1361 16         64 my $aref = _prepare_listrefs(\%data);
1362              
1363 16         57 my $unionref = _calculate_union_only($aref);
1364 16 100       45 my @union = $unsortflag ? keys %{$unionref} : sort(keys %{$unionref});
  8         40  
  8         70  
1365 16         118 return \@union;
1366             }
1367              
1368             sub get_intersection {
1369 8     8   5841 return @{ get_intersection_ref(shift) };
  8         38  
1370             }
1371              
1372             sub get_intersection_ref {
1373 16     16   5386 my $class = shift;
1374 16         76 my %data = %$class;
1375 16         40 my $unsortflag = $data{'unsort'};
1376 16         55 my $aref = _prepare_listrefs(\%data);
1377 16         77 my $intermediate_ref = _calculate_intermediate($aref);
1378             my @intersection =
1379 16 100       63 $unsortflag ? keys %{$intermediate_ref} : sort(keys %{$intermediate_ref});
  8         30  
  8         31  
1380 16         86 return \@intersection;
1381             }
1382              
1383             sub get_nonintersection {
1384 8     8   14261 return @{ get_nonintersection_ref(shift) };
  8         43  
1385             }
1386              
1387             sub get_nonintersection_ref {
1388 16     16   6755 my $class = shift;
1389 16         94 my %data = %$class;
1390 16         56 my $unsortflag = $data{'unsort'};
1391 16         68 my $aref = _prepare_listrefs(\%data);
1392              
1393 16         59 my $unionref = _calculate_union_only($aref);
1394 16         79 my $intermediate_ref = _calculate_intermediate($aref);
1395 16         50 my (@nonintersection);
1396 16         31 foreach my $el (keys %{$unionref}) {
  16         72  
1397 160 100       370 push(@nonintersection, $el) unless exists $intermediate_ref->{$el};
1398             }
1399 16 100       189 return [ $unsortflag ? @nonintersection : sort(@nonintersection) ];
1400             }
1401              
1402             sub get_shared {
1403 8     8   6027 return @{ get_shared_ref(shift) };
  8         39  
1404             }
1405              
1406             sub get_shared_ref {
1407 16     16   5829 my $class = shift;
1408 16         76 my %data = %$class;
1409 16         41 my $unsortflag = $data{'unsort'};
1410 16         56 my $aref = _prepare_listrefs(\%data);
1411 16         52 my $aseenref = _calculate_array_seen_only($aref);
1412 16         50 my $intermediate = _calculate_sharedref($aseenref);
1413 16 100       55 my @shared = $unsortflag ? keys %{$intermediate} : sort(keys %{$intermediate});
  8         36  
  8         102  
1414 16         145 return \@shared;
1415             }
1416              
1417             sub get_symmetric_difference {
1418 32     32   27367 return @{ get_symmetric_difference_ref(shift) };
  32         98  
1419             }
1420              
1421             sub get_symmetric_difference_ref {
1422 64     64   11707 my $class = shift;
1423 64         347 my %data = %$class;
1424 64         156 my $unsortflag = $data{'unsort'};
1425 64         217 my $aref = _prepare_listrefs(\%data);
1426 64         199 my $unionref = _calculate_union_only($aref);
1427              
1428 64         175 my $aseenref = _calculate_array_seen_only($aref);
1429 64         526 my $sharedref = _calculate_sharedref($aseenref);
1430              
1431 64         106 my (@symmetric_difference);
1432 64         100 foreach my $el (keys %{$unionref}) {
  64         212  
1433 640 100       1242 push(@symmetric_difference, $el) unless exists $sharedref->{$el};
1434             }
1435 64 100       859 return [ $unsortflag ? @symmetric_difference : sort(@symmetric_difference) ];
1436             }
1437              
1438             {
1439 34     34   300 no warnings 'once';
  34         101  
  34         8959  
1440             *get_symdiff = \&get_symmetric_difference;
1441             *get_symdiff_ref = \&get_symmetric_difference_ref;
1442             }
1443              
1444             sub get_LorRonly {
1445 16     16   40916 my $class = shift;
1446 16         115 my $method = (caller(0))[3];
1447 16         188 $method =~ s/.*::(\w*)$/$1/;
1448 16         1669 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         951 get_symmetric_difference($class);
1450             }
1451              
1452             sub get_LorRonly_ref {
1453 16     16   60231 my $class = shift;
1454 16         115 my $method = (caller(0))[3];
1455 16         156 $method =~ s/.*::(\w*)$/$1/;
1456 16         1578 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         887 get_symmetric_difference_ref($class);
1458             }
1459              
1460             {
1461 34     34   276 no warnings 'once';
  34         74  
  34         15093  
1462             *get_AorBonly = \&get_LorRonly;
1463             *get_AorBonly_ref = \&get_LorRonly_ref;
1464             }
1465              
1466             sub get_unique {
1467 36     36   15132 my $class = shift;
1468 36         202 my %data = %$class;
1469 36 100       146 my $index = defined $_[0] ? shift : 0;
1470 36         88 return @{ get_unique_ref($class, $index) };
  36         87  
1471             }
1472              
1473             sub get_unique_ref {
1474 77     77   10275 my $class = shift;
1475 77         455 my %data = %$class;
1476 77 100       276 my $index = defined $_[0] ? shift : 0;
1477 77         274 my $aref = _prepare_listrefs(\%data);
1478 77         132 _index_message3($index, $#{$aref});
  77         375  
1479              
1480 72         264 my $unique_all_ref = _unique_all_engine($aref);
1481 72         115 return ${$unique_all_ref}[$index];
  72         619  
1482             }
1483              
1484             sub get_unique_all {
1485 8     8   21622 my $class = shift;
1486 8         59 my %data = %$class;
1487 8         42 my $aref = _prepare_listrefs(\%data);
1488 8         37 return _unique_all_engine($aref);
1489             }
1490              
1491             sub get_Lonly {
1492 24     24   68304 my ($class, $index) = @_;
1493 24         189 my $method = (caller(0))[3];
1494 24         271 $method =~ s/.*::(\w*)$/$1/;
1495 24         2797 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         1867 get_unique($class, $index);
1497             }
1498              
1499             sub get_Lonly_ref {
1500 24     24   137227 my ($class, $index) = @_;
1501 24         168 my $method = (caller(0))[3];
1502 24         225 $method =~ s/.*::(\w*)$/$1/;
1503 24         2536 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         1563 get_unique_ref($class, $index);
1505             }
1506              
1507             {
1508 34     34   265 no warnings 'once';
  34         64  
  34         17311  
1509             *get_Aonly = \&get_Lonly;
1510             *get_Aonly_ref = \&get_Lonly_ref;
1511             }
1512              
1513             sub get_complement {
1514 44     44   32449 my $class = shift;
1515 44         248 my %data = %$class;
1516 44 100       184 my $index = defined $_[0] ? shift : 0;
1517 44         76 return @{ get_complement_ref($class, $index) };
  44         105  
1518             }
1519              
1520             sub get_complement_ref {
1521 93     93   14380 my $class = shift;
1522 93         426 my %data = %$class;
1523 93 100       278 my $index = defined $_[0] ? shift : 0;
1524 93         177 my $unsortflag = $data{'unsort'};
1525 93         350 my $aref = _prepare_listrefs(\%data);
1526 93         170 _index_message3($index, $#{$aref});
  93         441  
1527              
1528 88         328 my $complement_all_ref = _complement_all_engine($aref, $unsortflag );
1529 88         163 return ${$complement_all_ref}[$index];
  88         840  
1530             }
1531              
1532             sub get_complement_all {
1533 8     8   19907 my $class = shift;
1534 8         63 my %data = %$class;
1535 8         51 my $aref = _prepare_listrefs(\%data);
1536 8         67 return _complement_all_engine($aref);
1537             }
1538              
1539             sub get_Ronly {
1540 28     28   72258 my ($class, $index) = @_;
1541 28         201 my $method = (caller(0))[3];
1542 28         248 $method =~ s/.*::(\w*)$/$1/;
1543 28         2740 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         1764 &get_complement($class, $index);
1545             }
1546              
1547             sub get_Ronly_ref {
1548 28     28   103362 my ($class, $index) = @_;
1549 28         237 my $method = (caller(0))[3];
1550 28         256 $method =~ s/.*::(\w*)$/$1/;
1551 28         2619 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         1675 &get_complement_ref($class, $index);
1553             }
1554              
1555             {
1556 34     34   270 no warnings 'once';
  34         69  
  34         3662  
1557             *get_Bonly = \&get_Ronly;
1558             *get_Bonly_ref = \&get_Ronly_ref;
1559             }
1560              
1561             sub is_LsubsetR {
1562 48     48   20663 my $class = shift;
1563 48         240 my %data = %$class;
1564 48         240 my $subset_status = _subset_engine_multaccel(\%data, @_);
1565 40         130 return $subset_status;
1566             }
1567              
1568 34     34   248 { no warnings 'once'; *is_AsubsetB = \&is_LsubsetR; }
  34         74  
  34         5696  
1569              
1570             sub is_RsubsetL {
1571 16     16   39378 my $class = shift;
1572 16         103 my %data = %$class;
1573              
1574 16         121 my $method = (caller(0))[3];
1575 16         143 $method =~ s/.*::(\w*)$/$1/;
1576 16         1634 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         997 @_ = (1,0);
1578              
1579 16         84 my $subset_status = _subset_engine_multaccel(\%data, @_);
1580 16         126 return $subset_status;
1581             }
1582              
1583 34     34   243 { no warnings 'once'; *is_BsubsetA = \&is_RsubsetL; }
  34         66  
  34         4651  
1584              
1585             sub is_LequivalentR {
1586 33     33   27327 my $class = shift;
1587 33         178 my %data = %$class;
1588 33         124 my $aref = _prepare_listrefs(\%data);
1589 33         68 my ($index_left, $index_right) = _index_message4($#{$aref}, @_);
  33         126  
1590              
1591 24         122 my $xequivalentref = _equivalent_subengine($aref);
1592 24         41 return ${$xequivalentref}[$index_left][$index_right];
  24         144  
1593             }
1594              
1595 34     34   266 { no warnings 'once'; *is_LeqvlntR = \&is_LequivalentR; }
  34         122  
  34         51662  
1596              
1597             sub is_LdisjointR {
1598 29     29   9147 my $class = shift;
1599 29         154 my %data = %$class;
1600 29         112 my $aref = _prepare_listrefs(\%data);
1601 29         93 my ($index_left, $index_right) = _index_message4($#{$aref}, @_);
  29         121  
1602 24         123 my $aseenref = _calculate_array_seen_only(
1603             [ $aref->[$index_left], $aref->[$index_right] ]
1604             );
1605 24         58 my $disjoint_status = 1;
1606 24         39 OUTER: for my $k (keys %{$aseenref->[0]}) {
  24         82  
1607 51 100       120 if ($aseenref->[1]->{$k}) {
1608 16         29 $disjoint_status = 0;
1609 16         47 last OUTER;
1610             }
1611             }
1612 24         147 return $disjoint_status;
1613             }
1614              
1615             sub is_member_which {
1616 92     92   28959 return @{ is_member_which_ref(@_) };
  92         181  
1617             }
1618              
1619             sub is_member_which_ref {
1620 185     185   23921 my $class = shift;
1621 185 100 100     1583 croak "Method call requires exactly 1 argument (no references): $!"
1622             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1623 176         254 my %data = %{$class};
  176         614  
1624 176         482 my $aref = _prepare_listrefs(\%data);
1625 176         417 my $seenref = _calculate_seen_only($aref);
1626 176         320 my ($arg, @found);
1627 176         271 $arg = shift;
1628 176         267 foreach (sort keys %{$seenref}) {
  176         670  
1629 880 100       1159 push @found, $_ if (exists ${$seenref}{$_}{$arg});
  880         2014  
1630             }
1631 176         1079 return \@found;
1632             }
1633              
1634             sub are_members_which {
1635 13     13   23006 my $class = shift;
1636 13 100 100     493 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         43 my $aref = _prepare_listrefs(\%data);
1640 8         37 my $seenref = _calculate_seen_only($aref);
1641 8         28 my (@args, %found);
1642 8         31 @args = @{$_[0]};
  8         39  
1643 8         68 for (my $i=0; $i<=$#args; $i++) {
1644 88         124 my (@not_found);
1645 88         195 foreach (sort keys %{$seenref}) {
  88         255  
1646 440         544 exists ${${$seenref}{$_}}{$args[$i]}
  440         918  
1647 440 100       545 ? push @{$found{$args[$i]}}, $_
  216         492  
1648             : push @not_found, $_;
1649             }
1650 88 100       174 $found{$args[$i]} = [] if (@not_found == keys %{$seenref});
  88         287  
1651             }
1652 8         71 return \%found;
1653             }
1654              
1655             sub is_member_any {
1656 93     93   15849 my $class = shift;
1657 93 100 100     855 croak "Method call requires exactly 1 argument (no references): $!"
1658             unless (@_ == 1 and ref($_[0]) ne 'ARRAY');
1659 88         348 my %data = %$class;
1660 88         240 my $aref = _prepare_listrefs(\%data);
1661 88         210 my $seenref = _calculate_seen_only($aref);
1662 88         136 my ($arg, $k);
1663 88         165 $arg = shift;
1664 88         111 while ( $k = each %{$seenref} ) {
  193         458  
1665 185 100       273 return 1 if (defined ${$seenref}{$k}{$arg});
  185         709  
1666             }
1667 8         54 return 0;
1668             }
1669              
1670             sub are_members_any {
1671 13     13   7315 my $class = shift;
1672 13 100 100     503 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         52 my %data = %$class;
1675 8         52 my $aref = _prepare_listrefs(\%data);
1676 8         34 my $seenref = _calculate_seen_only($aref);
1677 8         24 my (@args, %present);
1678 8         20 @args = @{$_[0]};
  8         46  
1679 8         103 for (my $i=0; $i<=$#args; $i++) {
1680 88         121 foreach (keys %{$seenref}) {
  88         200  
1681 440 100       871 unless (defined $present{$args[$i]}) {
1682 181 100       217 $present{$args[$i]} = 1 if ${$seenref}{$_}{$args[$i]};
  181         450  
1683             }
1684             }
1685 88 100       245 $present{$args[$i]} = 0 if (! defined $present{$args[$i]});
1686             }
1687 8         90 return \%present;
1688             }
1689              
1690             sub print_subset_chart {
1691 8     8   11946 my $class = shift;
1692 8         57 my %data = %$class;
1693 8         55 my $aref = _prepare_listrefs(\%data);
1694 8         50 my $xsubsetref = _subset_subengine($aref);
1695 8         27 my $title = 'Subset';
1696 8         50 _chart_engine_multiple($xsubsetref, $title);
1697             }
1698              
1699             sub print_equivalence_chart {
1700 8     8   27808 my $class = shift;
1701 8         57 my %data = %$class;
1702 8         47 my $aref = _prepare_listrefs(\%data);
1703 8         47 my $xequivalentref = _equivalent_subengine($aref);
1704 8         28 my $title = 'Equivalence';
1705 8         35 _chart_engine_multiple($xequivalentref, $title);
1706             }
1707              
1708             sub get_bag {
1709 8     8   6728 return @{ get_bag_ref(shift) };
  8         68  
1710             }
1711              
1712             sub get_bag_ref {
1713 16     16   7545 my $class = shift;
1714 16         101 my %data = %$class;
1715 16         45 my $unsortflag = $data{'unsort'};
1716 16         106 my $aref = _prepare_listrefs(\%data);
1717 16         36 my (@bag);
1718 16         34 my @listrefs = @{$aref};
  16         62  
1719 16 100       66 if (ref($listrefs[0]) eq 'ARRAY') {
1720 8         22 foreach my $lref (@listrefs) {
1721 40         67 foreach my $el (@{$lref}) {
  40         72  
1722 256         421 push(@bag, $el);
1723             }
1724             }
1725             } else {
1726 8         30 foreach my $lref (@listrefs) {
1727 40         57 foreach my $key (keys %{$lref}) {
  40         87  
1728 216         302 for (my $j=1; $j <= ${$lref}{$key}; $j++) {
  472         874  
1729 256         447 push(@bag, $key);
1730             }
1731             }
1732             }
1733             }
1734 16 100       158 @bag = sort(@bag) unless $unsortflag;
1735 16         160 return \@bag;
1736             }
1737              
1738             sub get_version {
1739 8     8   5206 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.54 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