6
Array::Compare - Perl extension for comparing arrays.
12
my $comp1 = Array::Compare->new;
14
$comp->Skip({3 => 1, 4 => 1});
18
my $comp2 = Array::Compare->new(Sep => '|',
21
Skip => {3 => 1, 4 => 1});
26
$comp1->compare(\@arr1, \@arr2);
27
$comp2->compare(\@arr1, \@arr2);
31
If you have two arrays and you want to know if they are the same or
32
different, then Array::Compare will be useful to you.
34
All comparisons are carried out via a comparator object. In the
35
simplest usage, you can create and use a comparator object like
41
my $comp = Array::Compare->new;
43
if ($comp->compare(\@arr1, \@arr2)) {
44
print "Arrays are the same\n";
46
print "Arrays are different\n";
49
Notice that you pass references to the two arrays to the comparison
52
Internally the comparator compares the two arrays by using C<join>
53
to turn both arrays into strings and comparing the strings using
54
C<eq>. In the joined strings, the elements of the original arrays
55
are separated with the C<^G> character. This can cause problems if
56
your array data contains C<^G> characters as it is possible that
57
two different arrays can be converted to the same string.
59
To avoid this, it is possible to override the default separator
60
character, either by passing and alternative to the C<new> function
62
my $comp = Array::Compare->new(Sep => '|');
64
or by changing the seperator for an existing comparator object
68
In general you should choose a separator character that won't appear
71
You can also control whether or not whitespace within the elements of
72
the arrays should be considered significant when making the comparison.
73
The default is that all whitespace is significant. The alternative is
74
for all consecutive white space characters to be converted to a single
75
space for the pruposes of the comparison. Again, this can be turned on
76
when creating a comparator object:
78
my $comp = Array::Compare->new(WhiteSpace => 0);
80
or by altering an existing object:
84
You can also control whether or not the case of the data is significant
85
in the comparison. The default is that the case of data is taken into
86
account. This can be changed in the standard ways when creating a new
89
my $comp = Array::Compare->new(Case => 0);
91
or by altering an existing object:
95
In addition to the simple comparison described above (which returns true
96
if the arrays are the same and false if they're different) there is also
97
a full comparison which returns a list containing the indexes of elements
98
which differ between the two arrays. If the arrays are the same it returns
99
an empty list. In scalar context the full comparison returns the length of
100
this list (i.e. the number of elements that differ). You can access the full
101
comparision in two ways. Firstly, there is a C<DefFull> attribute. If this
102
is C<true> then a full comparison if carried out whenever the C<compare>
105
my $comp = Array::Compare->new(DefFull => 1);
106
$comp->compare(\@arr1, \@arr2); # Full comparison
109
$comp->compare(\@arr1, \@arr2); # Simple comparison
112
$comp->compare(\@arr1, \@arr2); # Full comparison again
115
Secondly, you can access the full comparison method directly
117
$comp->full_compare(\@arr1, \@arr2);
119
For symmetry, there is also a direct method to use to call the simple
122
$comp->simple_compare(\@arr1, \@arr2);
124
The final complication is the ability to skip elements in the comparison.
125
If you know that two arrays will always differ in a particular element
126
but want to compare the arrays I<ignoring> this element, you can do it
127
with Array::Compare without taking array slices. To do this, a
128
comparator object has an optional attribute called C<Skip> which is a
129
reference to a hash. The keys in this hash are the indexes of the array
130
elements and the values should be any true value for elements that should
133
For example, if you want to compare two arrays, ignoring the values in
134
elements two and four, you can do something like this:
136
my %skip = (2 => 1, 4 => 1);
137
my @a = (0, 1, 2, 3, 4, 5);
138
my @b = (0, 1, X, 3, X, 5);
140
my $comp = Array::Compare->new(Skip => \%skip);
142
$comp->compare(\@a, \@b);
144
This should return I<true>, as we are explicitly ignoring the columns
147
Of course, having created a comparator object with no skip hash, it is
148
possible to add one later:
150
$comp->Skip({1 => 1, 2 => 1});
154
my %skip = (1 => 1, 2 => 2);
157
To reset the comparator so that no longer skips elements, set the skip
158
hash to an empty hash.
162
You can also check to see if one array is a permutation of another, i.e.
163
they contain the same elements but in a different order.
165
if ($comp->perm(\@a, \@b) {
166
print "Arrays are perms\n";
168
print "Nope. Arrays are completely different\n";
171
In this case the values of C<WhiteSpace> and C<Case> are still used,
172
but C<Skip> is ignored for, hopefully, obvious reasons.
178
package Array::Compare;
181
use vars qw($VERSION $AUTOLOAD);
187
my %_defaults = (Sep => '^G',
193
=head2 new [ %OPTIONS ]
195
Constructs a new comparison object.
197
Takes an optional hash containing various options that control how
198
comparisons are carried out. Any omitted options take useful defaults.
204
This is the value that is used to separate fields when the array is joined
205
into a string. It should be a value which doesn't appear in your data.
210
Flag that indicates whether or not whitespace is significant in the
211
comparison. If this value is true then all multiple whitespace characters
212
are changed into a single space before the comparison takes place. Default
213
is 1 (whitespace is significant).
217
Flag that indicates whther or not the case of the data should be significant
218
in the comparison. Default is 1 (case is significant).
222
a reference to a hash which contains the numbers of any columns that should
223
be skipped in the comparison. Default is an empty hash (all columns are
228
Flag which indicates whether the default comparison is simple (just returns
229
true if the arrays are the same or false if they're not) or full (returns an
230
array containing the indexes of the columns that differ). Default is 0 (simple
240
my $self = {%_defaults, @_};
248
# Utility function to check the arguments to any of the comparison
249
# function. Ensures that there are two arguments and that they are
254
croak('Must compare two arrays.') unless @_ == 2;
255
croak('Argument 1 is not an array') unless ref($_[0]) eq 'ARRAY';
256
croak('Argument 2 is not an array') unless ref($_[1]) eq 'ARRAY';
261
=head2 compare_len \@ARR1, \@ARR2
263
Very simple comparison. Just checks the lengths of the arrays are
271
$self->_check_args(@_);
273
return @{$_[0]} == @{$_[1]};
276
=head2 compare \@ARR1, \@ARR2
278
Compare the values in two arrays and return a data indicating whether
279
the arrays are the same. The exact return values differ depending on
280
the comparison method used. See the descriptions of L<simple_compare>
281
and L<full_compare> for details.
283
Uses the value of DefFull to determine which comparison routine
291
if ($self->DefFull) {
292
return $self->full_compare(@_);
294
return $self->simple_compare(@_);
298
=head2 simple_compare \@ARR1, \@ARR2
300
Compare the values in two arrays and return a flag indicating whether or
301
not the arrays are the same.
303
Returns true if the arrays are the same or false if they differ.
305
Uses the values of 'Sep', 'WhiteSpace' and 'Skip' to influence
313
$self->_check_args(@_);
315
my ($row1, $row2) = @_;
317
# No point in continuing if the number of elements is different.
318
return unless $self->compare_len(@_);
320
# @check contains the indexes into the two arrays, i.e. the numbers
321
# from 0 to one less than the number of elements.
322
my @check = 0 .. $#$row1;
324
my ($pkg, $caller) = (caller(1))[0, 3];
325
my $perm = $caller eq __PACKAGE__ . "::perm";
327
# Filter @check so it only contains indexes that should be compared.
328
# N.B. Makes no sense to do this if we are called from 'perm'.
330
@check = grep {!(exists $self->Skip->{$_}
331
&& $self->Skip->{$_}) } @check
332
if keys %{$self->Skip};
335
# Build two strings by taking array slices containing only the columns
336
# that we shouldn't skip and joining those array slices using the Sep
337
# character. Hopefully we can then just do a string comparison.
338
# Note: this makes the function liable to errors if your arrays
339
# contain the separator character.
340
my $str1 = join($self->Sep, @{$row1}[@check]);
341
my $str2 = join($self->Sep, @{$row2}[@check]);
343
# If whitespace isn't significant, collapse it
344
unless ($self->WhiteSpace) {
349
# If case isn't significant, change to lower case
350
unless ($self->Case) {
355
return $str1 eq $str2;
358
=head2 full_compare \@ARR1, \@ARR2
360
Do a full comparison between two arrays.
362
Checks each individual column. In scalar context returns the number
363
of columns that differ (zero if the arrays are the same). In list
364
context returns an list containing the indexes of the columns that
365
differ (an empty list if the arrays are the same).
367
Uses the values of 'Sep' and 'WhiteSpace' to influence the comparison.
369
B<Note:> If the two arrays are of different lengths then this method
370
just returns the indexes of the elements that appear in one array but
371
not the other (i.e. the indexes from the longer array that are beyond
372
the end of the shorter array). This might be a little
380
$self->_check_args(@_);
382
my ($row1, $row2) = @_;
384
# No point in continuing if the number of elements is different.
385
# Because of the expected return value from this function we can't
386
# just say 'the arrays are different'. We need to do some work to
387
# calculate a meaningful return value.
388
# If we've been called in array context we return a list containing
389
# the number of the columns that appear in the longer list and aren't
390
# in the shorter list. If we've been called in scalar context we
391
# return the difference in the lengths of the two lists.
392
unless ($self->compare_len(@_)) {
395
if ($#{$row1} > $#{$row2}) {
396
($max, $min) = ($#{$row1}, $#{$row2} + 1);
398
($max, $min) = ($#{$row2}, $#{$row1} + 1);
400
return ($min .. $max);
402
return abs(@{$row1} - @{$row2});
406
my ($arr1, $arr2) = @_;
410
foreach (0 .. $#{$arr1}) {
411
next if keys %{$self->Skip} && $self->Skip->{$_};
413
my ($val1, $val2) = ($arr1->[$_], $arr2->[$_]);
414
unless ($self->WhiteSpace) {
419
unless ($self->Case) {
424
push @diffs, $_ unless $val1 eq $val2;
427
return wantarray ? @diffs : scalar @diffs;
430
=head2 perm \@ARR1, \@ARR2
432
Check to see if one array is a permutation of the other (i.e. contains
433
the same set of elements, but in a different order).
435
We do this by sorting the arrays and passing references to the assorted
436
versions to simple_compare. There are also some small changes to
437
simple_compare as it should ignore the Skip hash if we are called from
445
return $self->simple_compare([sort @{$_[0]}], [sort @{$_[1]}]);
449
# Attempt to be clever with object attributes.
450
# Each object attribute is always accessed using an access method.
451
# None of these access methods exist in the object code.
452
# If an unknown method is called then the AUTOLOAD method is called
453
# in its place with the same parameters and the variable $AUTOLOAD
454
# set to the name of the unknown method.
456
# In this function we work out which method has been called and
457
# simulate it by returning the correct attribute value (and setting
458
# it to a new value if the method was passed a new value to use).
460
# We're also a little cleverer than that as we create a new method on
461
# the fly so that the next time we call the missing method it has
462
# magically sprung into existance, thereby avoiding the overhead of
463
# calling AUTOLOAD more than once for each method called.
467
my ($self, $val) = @_;
468
my ($name) = $AUTOLOAD =~ m/.*::(\w*)/;
470
*{$AUTOLOAD} = sub { return @_ > 1 ?
471
$_[0]->{$name} = $_[1] :
474
return defined $val ? $self->{$name} = $val : $self->{$name};
478
# One (small) downside of the AUTOLOAD trick, is that we need to
479
# explicitly define a DESTROY method to prevent Perl from passing
480
# those calls to AUTOLOAD. In this case we don't need to do anything.
489
Dave Cross <dave@mag-sol.com>
497
Copyright (C) 2000-2005, Magnum Solutions Ltd. All Rights Reserved.
499
This script is free software; you can redistribute it and/or modify it
500
under the same terms as Perl itself.
506
# Revision 1.13 2005/09/21 09:23:40 dave
509
# Revision 1.12 2005/03/01 09:05:33 dave
510
# Changes to pass Pod::Coverage tests (and, hence, increase kwalitee)
512
# Revision 1.11 2004/10/23 08:11:32 dave
513
# Improved test coverage
515
# Revision 1.10 2004/10/22 20:32:48 dave
516
# Improved docs for full comparison
518
# Revision 1.9 2003/09/19 09:37:40 dave
519
# Bring CVS version into line with old file
521
# Revision 1.1 2003/09/19 09:34:43 dave
524
# Revision 1.7 2002/03/29 17:45:09 dave
527
# Revision 1.6 2002/01/09 11:41:52 dave
530
# Revision 1.5 2001/12/09 19:31:47 dave
533
# Revision 1.4 2001/06/04 20:47:01 dave
536
# Revision 1.3 2001/02/26 13:34:41 dave
537
# Added case insensitivity.
539
# Revision 1.2 2000/06/04 17:43:14 dave
540
# Renamed 'manifest' and 'readme' to 'MANIFEST' and 'README'.
543
# Revision 1.1.1.1 2000/06/04 17:40:19 dave
546
# Revision 0.2 00/05/13 14:23:48 14:23:48 dave (Dave Cross)
547
# Added 'perm' method.
548
# Revision 0.1 00/04/25 13:33:55 13:33:55 dave (Dave Cross)
added
removed
t/lib/Array/Compare.pm
