Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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


In reply to Re: Set intersection problem by kcott
in thread Set intersection problem by baxy77bax

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Domain Nodelet?
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this?Last hourOther CB clients
    Other Users?
    Others imbibing at the Monastery: (4)
    As of 2024-09-17 05:21 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      The PerlMonks site front end has:





      Results (22 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.