Re: 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 ) ];
[download]

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
[download]

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.

Comment on Re: Powerset short-circuit optimization Select or Download Code

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	[reply]
Re^3: Powerset short-circuit optimization by ikegami (Patriarch) on Oct 03, 2006 at 23:29 UTC
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_}++; } };` [download] 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);` [download]	[reply] [d/l] [select]