### Re: Set intersection problem

by kcott (Archbishop)
 on May 23, 2023 at 15:36 UTC Need Help??

in reply to Set intersection problem

G'day baxy77bax,

"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;

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

— Ken

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11152395]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (7)
As of 2024-09-20 10:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
The PerlMonks site front end has:

Results (25 votes). Check out past polls.

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.