| robic0@yahoo.com 2006-12-24, 4:02 am |
| On Sat, 23 Dec 2006 06:03:03 -0800, PerlFAQ Server <brian@stonehenge.com> wrote:
>This is an excerpt from the latest version perlfaq4.pod, which
>comes with the standard Perl distribution. These postings aim to
>reduce the number of repeated questions as well as allow the community
>to review and update the answers. The latest version of the complete
>perlfaq is at http://faq.perl.org .
>
>--------------------------------------------------------------------
>
>4.43: How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
>
> Use a hash. Here's code to do both and more. It assumes that each
> element is unique in a given array:
>
> @union = @intersection = @difference = ();
> %count = ();
> foreach $element (@array1, @array2) { $count{$element}++ }
> foreach $element (keys %count) {
> push @union, $element;
> push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
> }
>
> Note that this is the *symmetric difference*, that is, all elements in
> either A or in B but not in both. Think of it as an xor operation.
>
>
>
>--------------------------------------------------------------------
>
>The perlfaq-workers, a group of volunteers, maintain the perlfaq. They
>are not necessarily experts in every domain where Perl might show up,
>so please include as much information as possible and relevant in any
>corrections. The perlfaq-workers also don't have access to every
>operating system or platform, so please include relevant details for
>corrections to examples that do not work on particular platforms.
>Working code is greatly appreciated.
>
>If you'd like to help maintain the perlfaq, see the details in
>perlfaq.pod.
I'd seen this FAQ many times and just stare at it in wonder.
Not because of the code (which I don't understand).
I wonder about the usefullness of a *difference* algo when it
comes to array comparisons.
I mean I thought and thought. If we substitute "array" for something like
"lines in a file", I could see some usefullness when it comes to software that
would do something like source control where (and here is the funny thing about that)
either the current version is always stored (only 1 current version) and the differences
are saved, or the original version is stored and the differences are saved.
I have, however had use for the "negative" ie: find the common elements from two arrays.
Its probably the same thing, just in reverse (from your code).
I've posted some code below that I use but would be very interested if you would have a way to
to it faster. The faster the better as it is time critical part of a program I use quite alot.
THANKS!
Robic0
########################################
###############
# Get Common Elements (from two N-dimensioned Array's)
# IN - Refs to the NxN arrays to compare,
# sort flag and the compare field.
# OUT - Ndx's into Right_Array of matching elements
# ---------------------------------------------------
# Notes -
# 1. Elements are assumed textual and case insensitive
# 2. Ignores in-array duplicates
# 3. Sort will be done if sort flag > 0
#
sub GetCommonElementsNxM()
{
my ($A_Left,$A_Right,$Srtflg,$Fld) = @_;
$Srtflg = 0 unless defined $Srtflg;
$Fld = 0 unless defined $Fld;
# my @Dup = ();
my @Ndx = ();
if ($Srtflg > 0) {
@{$A_Left} = sort {uc($a->[$Fld]) cmp uc($b->[$Fld])} @{$A_Left};
@{$A_Right} = sort {uc($a->[$Fld]) cmp uc($b->[$Fld])} @{$A_Right};
} else {print "==> Common Elements : Not sorting arrays\n";}
my $rpos = 0;
my $rend = @{$A_Right};
my $cnt = 0;
my $llast = undef;
my $rlast = undef;
foreach my $left_element (@{$A_Left})
{
next if (uc($left_element->[$Fld]) eq uc($llast->[$Fld]));
$rpos += $cnt;
$cnt = 0;
foreach my $right_element (@{$A_Right}[$rpos..($rend-1)])
{
last if (uc($left_element->[$Fld]) lt uc($right_element->[$Fld]));
$cnt++;
next if (uc($right_element->[$Fld]) eq uc($rlast->[$Fld]));
if (uc($left_element->[$Fld]) eq uc($right_element->[$Fld]))
{
# push (@Dup, $right_element->[$Fld]); # the string
push (@Ndx, $rpos+$cnt-1); # the index into R_Array
last;
}
$rlast = $right_element;
}
$llast = $left_element;
last if ($rpos >= $rend);
}
# return (@Dup);
return (@Ndx);
}
########################################
###############
# Get Common Elements from single Array's
# IN - Refs to the Nx1 arrays to compare, sort flag
# OUT - Ndx's into Right_Array of matching elements
# ---------------------------------------------------
# Notes -
# 1. Elements are assumed textual and case insensitive
# 2. Ignores in-array duplicates
# 3. Sort will be done if sort flag > 0
########################################
###############
sub GetCommonElements()
{
my ($A_Left,$A_Right,$Srtflg) = @_;
$Srtflg = 0 unless defined $Srtflg;
# my @Dup = ();
my @Ndx = ();
if ($Srtflg > 0) {
@{$A_Left} = sort {uc($a) cmp uc($b)} @{$A_Left};
@{$A_Right} = sort {uc($a) cmp uc($b)} @{$A_Right};
} else {print "==> Common Elements : Not sorting arrays\n";}
my $rpos = 0;
my $rend = @{$A_Right};
my $cnt = 0;
my $llast = '';
my $rlast = '';
foreach my $left_element (@{$A_Left})
{
next if (uc($left_element) eq uc($llast));
$rpos += $cnt;
$cnt = 0;
foreach my $right_element (@{$A_Right}[$rpos..($rend-1)])
{
last if (uc($left_element) lt uc($right_element));
$cnt++;
next if (uc($right_element) eq uc($rlast));
if (uc($left_element) eq uc($right_element))
{
# push (@Dup, $right_element); # the string
push (@Ndx, $rpos+$cnt-1); # the index into R_Array
last;
}
$rlast = $right_element;
}
$llast = $left_element;
last if ($rpos >= $rend);
}
# return (@Dup);
return (@Ndx);
}
|