Perl的。 比较具有重复值的数组

Question

I have two arrays of strings with repeated values that I would like to compare and get the number of add/del/upd(=same) elements:

my @array1 = ("aaa", "bbb", "ccc", "eee", "eee");
my @array2 = ("aaa", "aaa", "bbb", "ccc", "ccc", "ddd", "fff");

I need something like:

add: 4
del: 2
upd: 3

I tried List::Compare :

my @array1 = ("aaa", "bbb", "ccc", "eee", "eee");
my @array2 = ("aaa", "aaa", "bbb", "ccc", "ccc", "ddd", "fff");

my $lc = List::Compare->new(\@array1, \@array2);        
print Dumper "intersection (upd): ".scalar($lc->get_intersection);
print Dumper "only first   (del): ".scalar($lc->get_unique);
print Dumper "only second  (add): ".scalar($lc->get_complement);

But it cannot work for repeated values:

$VAR1 = 'intersection (upd): 3';
$VAR1 = 'only first   (del): 1';
$VAR1 = 'only second  (add): 2';

How can I solve this problem?

Answer 1

This will do what you need.

I trust the mechanism is clear. If you need further explanation please ask again.

use strict;
use warnings;

my @array1 = qw( aaa bbb ccc eee eee );
my @array2 = qw( aaa aaa bbb ccc ccc ddd fff );

my %data;

$data{$_}[0]++ for @array1;
$data{$_}[1]++ for @array2;

my ($add, $del, $upd) = (0, 0, 0);

for (values %data) {
  my ($a1, $a2) = map $_ // 0, @$_[0,1];
  if ($a1 < $a2) {
    $upd += $a1;
    $add += $a2 - $a1;
  }
  else {
    $upd += $a2;
    $del += $a1 - $a2;
  }
}

printf "add/del/upd = %d/%d/%d\n", $add, $del, $upd;

output

add/del/upd = 4/2/3

Answer 2

You're working with multisets (aka bags) (elements can occur multiple times), not sets (elements are unique). Use Set::Bag .