Update: Oh, boy, don't use this baby for high-order tuples.
Here's my entry:
use strict;
use warnings;
my %items = (
a => [ qw/one six/ ],
b => [ qw/two three five/ ],
c => [ qw/one two five/ ],
d => [ qw/one seven five/ ],
e => [ qw/one two five/ ],
f => [ qw/one two four seven/ ],
g => [ qw/one two five/ ],
h => [ qw/one two three five/ ],
);
my $tuple = 2;
# Build a reverse HoH
my %rHoH;
while (my ($k,$v) = each %items) {
$rHoH{$_}{$k} = undef for @$v;
}
# Determine all possible n-tuples
my @accum = ();
for my $elem (keys %rHoH) {
push @accum, ([$elem], map { @$_ < $tuple ? [@$_, $elem] : () } @a
+ccum);
}
@accum = grep { @$_ == $tuple } @accum;
# For each tuple in @accum, mark which items contained each member
# then count how many got marked for all of them
my @count;
for my $a (0..$#accum) {
my %ic; # item counter
for my $n (@{$accum[$a]}) {
++$ic{$_} for keys %{$rHoH{$n}};
}
$count[$a] = grep {$ic{$_} == $tuple} keys %ic;
}
# print the tuples out, with their counts, highest to lowest
printf "[%s]: $count[$_]\n", join(',', @{$accum[$_]})
for sort {$count[$b] <=> $count[$a]}
grep { $count[$_] > 1 }
0..$#accum;
Caution: Contents may have been coded under pressure.