Here's a simple example of List::Compare:

use List::Compare;

my $lol = [ [ 3, 4, 5, 6 ],
            [ 4, 5, 6, 7 ],
            [ 5, 6, 7, 8 ] ];

my $lc = List::Compare->new( @{$lol} );

my  @intersection = $lc->get_intersection;

print "$_\n" for @intersection;
[download]

Take a look at List::Compare - it can compare two or more lists. It does exactly what you are asking for.

@union = @intersection = @difference = ();
    %count = ();
    foreach $element (@array1, @array2) { $count{$element}++ }
    foreach $element (keys %count) {
        push @union, $element;
        push @{ $count{$element} > 1 ? \@intersection : \@difference }
+, $element;
    }
[download]

sub intersection{
 my(%count,@res);
 for(map @$_,@_){$count{$_}++}
 for(keys %count){push @res,$_ if $count{$_}==@_}
 @res;
}
@a=intersection(\@b,\@c,\@d);
[download]

#!/usr/local/bin/perl -w
use strict;
use Quantum::Superpositions;
my @y;
my $i = [ 3, 4, 5 ];
my $j = [ 3 ];
my $k = [ 3, 4, 5 ];
@y = eigenstates(all(any(@$i),any(@$j),any(@$k)));
print "first: @y\n";
$i = [ 5 ];
@y = eigenstates(all(any(@$i)));
print "second: @y\n";
$i = [ 3, 4, 5, 6 ];
$j = [ 4, 5, 6, 7 ];
$k = [ 5, 6, 7, 8 ];
@y = eigenstates(all(any(@$i),any(@$j),any(@$k)));
print "third: @y\n";
my $l = [ 9, 10, 11];
@y = eigenstates( all(any(@$i),any(@$j),any(@$k),any(@$l)));
print "fourth: @y\n";
__END__
[download]

my $numArrays = keys %ids;
my %count = ();
my @intersection = ();
foreach my $k (keys %ids) {
    my %uniq = map { $_ => 1 } @{ $ids{$k} };
    $count[$_]++ for keys %uniq;
}
foreach my $v (keys %count) {
    push @intersection, $v if $count[$v] == $numArrays;
}
[download]

Wouldn't this fail if the same element appears mulitple times in an array, such that the number of times it appears overall is == num of arrays? This code assumes all elements are unique in each array.

The next solution has the same assumption.

A quick look at the source of List::Compare leads me to think it does not make that assumption.

--Solo

--
You said you wanted to be around when I made a mistake; well, this could be it, sweetheart.

Wouldn't this fail if the same element appears mulitple times in an array, such that the number of times it appears overall is == num of arrays? This code assumes all elements are unique in each array.

The provided code does not make that assumption. The key lines are:

foreach my $k (keys %ids) {
    my %uniq = map { $_ => 1 } @{ $ids{$k} };
    $count[$_]++ for keys %uniq;
}
[download]

If the array in $ids{$k} has a whole bunch of 1s in it, that's okay, we'll overwrite $uniq{1} a whole bunch of times. Because hash keys must be unique.

This means that at the last statement in this loop %uniq will represent a hash with only the unique values from $ids{$k}

I hope this helps.

jarich

A slight improvement...

sub intersection {
    my $n = scalar @_;
    my %count;
    foreach my $list (@_) {
        my %elements = map { $_ => 1 } @$list;
        $count{$_}++ foreach keys %elements;
    }
    return [ grep { $count{$_} == $n } keys %count ];
}
[download]

use strict;
our %ids;

sub intersect
{
    my %count;
    my @ret;
    my $count = scalar keys %ids;
    foreach my $key (keys %ids) {
        my %this;
        for (@{$ids{$key}}) {
            next if $this{$_};
            $count{$_}++;
            $this{$_}++;
            if ($count{$_} == $count) {
                push @ret, $_;
            }
        }
    }

    undef %ids;
    return @ret;
}


$ids{'foo'} =  [ 3, 4, 4, 5 ];
$ids{'bar'} =  [ 3 ];
$ids{'zoo'} =  [ 3, 4, 5 ];

print "[ ",join(', ',intersect)," ]\n"; # prints "[ 3 ]"
[download]

The line

next if $this{$_};
[download]

should test existence rather than truth, like so

next if exists $this{$_};
[download]

--Solo

--
You said you wanted to be around when I made a mistake; well, this could be it, sweetheart.

This works with numbers, how can you make it work with strings.

c:\@Work\Perl\monks>perl
use strict;
use warnings;

my %ids;

sub intersect {

    my %count;
    my @ret;
    my $count = keys %ids;
    foreach my $key (keys %ids) {
        my %this;
        for (@{$ids{$key}}) {
            next if $this{$_};
            $count{$_}++;
            $this{$_}++;
            if ($count{$_} == $count) {
                push @ret, $_;
            }
        }
    }

    undef %ids;
    return @ret;
}

$ids{'foo'} = [ qw(three four four five) ];
$ids{'bar'} = [ qw(three) ];
$ids{'zoo'} = [ qw(five four three) ];

print "[ ",join(', ',intersect)," ]\n";

__END__
[ three ]
[download]

---

Give a man a fish:  <%-{-{-{-<

I thought I'd try Set::Array for myself, but it in turn wants Want, which I downloaded as well. But an attempt to "use Want;" pukes "Can't locate loadable object for module Want in @INC (@INC contains: c:\perl\lib c:\perl\site\lib .)" on me.

Yipes. This was after I put it into c:\perl\site\lib (and then into c:\perl\lib, with a shrug). Oddly enough, putting the Set::Array source into c:\perl\site\lib\Set\Array.pm seemed to make "use Set::Array;" work fine. It started spitting up when it in turn tried to use Want.

So what am I missing? I couldn't find any installation notes on the CPAN pages for either Set::Array or Want. Please help.

I don't mean to take this discussion off course, but just thought I'd explore one of the suggested solutions. I try to do this from time to time, simply out of curiosity and wanting to learn more and in hopes my brain will retain it (try to get new stuff in faster than the old stuff falls out).

Unfortunately, I've never used Set::Array myself .. I just thought it looked effective for the OP's problem.

You might want to start a new SoPW topic with this problem installing Want (and Set::Array?). I do notice that Set::Array does not show up on the "Module List" page of CPAN anymore, so maybe it's been abandoned. (I admit I don't know a whole lot of how CPAN is administered).