Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Re: Set intersection problem

by kcott (Archbishop)
on May 23, 2023 at 15:36 UTC ( [id://11152395]=note: print w/replies, xml ) 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

Log In?
Username:
Password:

What's my password?
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 musing on the Monastery: (5)
As of 2024-04-26 08:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found