This was a note I made while reading the Perl Cookbook.   I can't imagine the application which would use it as is, but it does summarize this stuff which does seem to come up all the time.
#!/usr/bin/perl   -w

# returns union, intersection and differences of two arrays
#          as per sections 14.7 and 14.8 of the Perl Cookbook
#          (but does not preserve order!)
# usage:
#  ( \@merged, \@common, \@only_a, \@only_b ) = intersets(\@a, \@b)

sub intersets {
  my ($a, $b) = @_;
  my (%ah, %bh);
  @ah{ @$a } = @$a; 
  @bh{ @$b } = ();
  delete @bh{ @$a };
  ( [ keys %ah, keys %bh ], [ grep defined, delete @ah{ @$b } ],
       [ keys %ah ], [ keys %bh ] )
}


my @a = qw(a b c d e);
my @b = qw(b e f g h i);
print "[ @a ],  [ @b ]\n
";
my($mrg, $common, $a, $b) = intersets(\@a, \@b);
print "merged: '@$mrg'\ncommon: '@$common'\n";
print "only a: '@$a'\nonly b: '@$b'\n";

=pod

[ a b c d e ],  [ b e f g h i ]

merged: 'a b c d e h i f g'
common: 'b e'
only a: 'a c d'
only b: 'h i f g'

=cut

[download]

Replies are listed 'Best First'.
•Re: finding union, intersection and differences of arrays
by merlyn (Sage) on Mar 06, 2002 at 00:41 UTC 
    my @a = qw(a b c d e f);
my @b = qw(c d e f g h);
my ($only_a, $only_b, $both, $either) = listy(\@a, \@b);
print "only in a: @$only_a\n";
print "only in b: @$only_b\n";
print "both: @$both\n";
print "either: @$either\n";

sub listy {
  my %tmp1;
  for (0..1) {
    for my $k (@{$_[$_]}) {
      $tmp1{$k} .= $_;
    }
  }
  my %tmp2;
  while (my($k, $v) = each %tmp1) {
    push @{$tmp2{$v}}, $k;
  }
  return @tmp2{"0", "1", "01"}, [keys %tmp1]; 
}

    [download]

    -- Randal L. Schwartz, Perl hacker

[reply]
[d/l]
      I seem to have nothing better to do, but in case you have more than two arrays.. 
      my ($only_a, $only_b, $only_c, $all, $any) = listy(\@a, \@b, \@c);

sub listy {
  my %tmp1;
  my @keys;
  for (0..$#_) {
    my $key = pop @keys;
    push @keys, $_, (defined $key ? $key : '') . $_;
    for my $k (@{$_[$_]}) {
      $tmp1{$k} .= $_;
    }
  }
  my %tmp2;
  while (my($k, $v) = each %tmp1) {
    push @{$tmp2{$v}}, $k;
  }
  return @tmp2{@keys}, [keys %tmp1];
}

      [download]
      (maybe I should have tested it better the first time. Fixed bug) Jasp
[reply]
[d/l]
Re: finding union, intersection and differences of arrays
by OfficeLinebacker (Chaplain) on Sep 01, 2006 at 03:37 UTC
    ++! Great work!

    _________________________________________________________________________________

    I like computer programming because it's like Legos for the mind.

[reply]

Back to Cool Uses for Perl