Re: Set intersection problem

"any algorithm that can produce a solution for more than 7 arrays would be acceptable"

Major Update: On reviewing my post, I noticed some of the intersections were missing: A-B-F, A-D, and so on. There was a major logic flaw in the 'for my $elem (keys %temp) { ... }' loop. I've completely rewritten that loop, made a couple of minor changes elsewhere, and reposted the output. The previous code and output has been stricken and is in the spoiler for any who wish to review the changes.

#!/usr/bin/env perl

use strict;
use warnings;

my %data = (
    A => [qw{ant bee cat dog eel fly gnu hog}],
    B => [qw{ant cat eel gnu}],
    C => [qw{bee dog fly hog}],
    D => [qw{cat fly ant}],
    E => [qw{ant dog gnu}],
    F => [qw{gnu bee}],
    G => [qw{eel hog}],
    H => [qw{zoo}],
    I => [qw{}],
);

my %temp;

for my $set (keys %data) {
    my @elems = @{$data{$set}};
    @elems = ('') unless @elems;

    for my $elem (@elems) {
        push @{$temp{$elem}}, $set;
    }
}

my (%venn, %seen);

for my $elem (sort keys %temp) {
    my @sets = @{$temp{$elem}};

    my $glob_expr = '{' . join(',', @sets) . '}';

    for my $i (1 .. $#sets) {
        $glob_expr .= '-{,' . join(',', @sets[$i .. $#sets]) . '}';
    }

    for my $key (glob($glob_expr)) {
        next if $key =~ /([^-]+)(?=.*?\1)/;
        $key =~ y/-/-/s;
        $key =~ s/(?:^-|-$)//g;
        $key = join '-', sort split /-/, $key;
        push @{$venn{$key}}, $elem unless $seen{$key}{$elem}++;
    }
}

# DEMO: Output
my $fmt = "%-7s  %s  %s\n";

{
    no warnings 'qw';
    printf $fmt, qw{Sets # Elements};
    printf $fmt, qw{---- - --------};
}

printf $fmt, $_, 0+@{$venn{$_}}, "@{$venn{$_}}" for sort keys %venn;
[download]

Output:

Sets     #  Elements
----     -  --------
A        8  ant bee cat dog eel fly gnu hog
A-B      4  ant cat eel gnu
A-B-D    2  ant cat
A-B-D-E  1  ant
A-B-E    2  ant gnu
A-B-E-F  1  gnu
A-B-F    1  gnu
A-B-G    1  eel
A-C      4  bee dog fly hog
A-C-D    1  fly
A-C-E    1  dog
A-C-F    1  bee
A-C-G    1  hog
A-D      3  ant cat fly
A-D-E    1  ant
A-E      3  ant dog gnu
A-E-F    1  gnu
A-F      2  bee gnu
A-G      2  eel hog
B        4  ant cat eel gnu
B-D      2  ant cat
B-D-E    1  ant
B-E      2  ant gnu
B-E-F    1  gnu
B-F      1  gnu
B-G      1  eel
C        4  bee dog fly hog
C-D      1  fly
C-E      1  dog
C-F      1  bee
C-G      1  hog
D        3  ant cat fly
D-E      1  ant
E        3  ant dog gnu
E-F      1  gnu
F        2  bee gnu
G        2  eel hog
H        1  zoo
I        1
[download]

— Ken

Comment on Re: Set intersection problem Select or Download Code


Clear questions and runnable code get the best and fastest answer
	PerlMonks