Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re: Powerset short-circuit optimization

by ikegami (Pope)
on Oct 03, 2006 at 18:17 UTC ( #576146=note: print w/replies, xml ) Need Help??


in reply to Powerset short-circuit optimization

An initial naïve solution:
use strict; use warnings; sub r(&$@) { my $cb = shift(@_); my %seen; local *_r = sub { my @v = @_; return if $seen{join $;, @v}++; return if not $cb->(@v); return if @v == 1; for (0..$#v) { my @v_ = @v; splice(@v_, $#v-$_, 1); _r(@v_); } }; _r(sort @$_) foreach @_; } r { print(@_, "\n"); 1 } [ qw( A B C D ) ], [ qw( A B C E ) ], [ qw( A B C F G ) ];

Output:

ABCD ABC AB A B AC C BC ABD AD D BD ACD CD BCD ABCE ABE AE E BE ACE CE BCE ABCFG ABCF ABF AF F BF ACF CF BCF ABCG ABG AG G BG ACG CG BCG ABFG AFG FG BFG ACFG CFG BCFG

Both the implementation and the algorithm can surely be improved.

Update: The code block now returns a value. This allows the option to skip, as desired.
Update: Slightly modified to attain your ultimate goal.
Update: (Bug fix) Added sort.
Update: I can't think of another algorithm. This will likely be my last solution.

Replies are listed 'Best First'.
Re^2: Powerset short-circuit optimization
by Limbic~Region (Chancellor) on Oct 03, 2006 at 22:13 UTC
    ikegami,
    This is the approach I previously discussed in the CB with jdporter and blokhead. The undesireable aspect is that _r() is called 29 times to yield 15 items for A,B,C,D instead of just 15. I am not sure there is a way around this but that's why I posted it.

    Cheers - L~R

      The following only calls _v 15 times. ;) Of course, splice (or its optimized equivalent) and %seen are still called 29 times, but that's a far cry less than the possible 41. Also, even with the original code, the (presumably expensive) callback is only called 15 times.

      local *_r = sub { my @v = @_; return if not $cb->(@v); return if @v == 1; for (0..$#v) { my @v_ = @v; splice(@v_, $#v-$_, 1); _r(@v_) if not $seen{join $;, @v_}++; } };

      It breaks the rule "A,B,C should be generated before A,C", but the following might allow you to break down the problem such that your requirements can be loosened:

      my ($u_set1, $u_set2, $common) = extract_common($set1, $set2); my $psetc = powerset($common); my $pset1 = product($psetc, powerset($u_set1)); my $pset2 = product($psetc, powerset($u_set2)); my $pset = union($pset1, $pset2);

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://576146]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (3)
As of 2020-10-25 13:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (249 votes). Check out past polls.

    Notices?