http://www.perlmonks.org?node_id=434581


in reply to Generating powerset with progressive ordering

Okay, first off, here's a somewhat general method, although it has the disadvantage of being highly recursive. You saw this already from the chatterbox:
sub printsubsets1 { my ($prefix, @elemarray) = @_; if (!@elemarray) {return;} my $elem = shift @elemarray; print "$prefix$elem\n"; printsubsets1 ("$prefix$elem", @elemarray); printsubsets1 ("$prefix ", @elemarray); } sub printsubsets { printsubsets1("",@_);} printsubsets(qw(a b c d e));

Now, here's a very evil, but iterative, method that only works on sets of single characters, but that should be enough since anything enumerating 2**26 possiblities is already going to take way, way too long. You could easily change the few lines around the "print" statement so that it dealt with sets of arbitrary words, but I'm just focused on getting the evil out there:

sub printsubsets2 { my $stuff = join('',@_); my $mask = "\xff" . ("\x00" x (length($stuff)-1)); do { my $str = $mask & $stuff; $str =~ y/\x00/ /; print $str,"\n"; if ($mask =~ s/\xff\x00(\x00*)$/\xff\xff$1/) {} elsif ($mask =~ s/\xff\x00(\x00*)\xff$/\x00\xff$1\x00/) {} elsif ($mask =~ s/\xff{2}$/\x00\xff/) {} else {return;} } while (1); } printsubsets2(qw(a b c d e));

You can of course take the core of this out and use it somewhat like this:

sub initialmask { my $nelem = shift; return "\xff" . ("\x00" x ($nelem-1)); } sub nextmask { if ($_[0] =~ s/\xff\x00(\x00*)$/\xff\xff$1/) {1;} elsif ($_[0] =~ s/\xff\x00(\x00*)\xff$/\x00\xff$1\x00/) {1;} elsif ($_[0] =~ s/\xff{2}$/\x00\xff/) {1;} else {0;} } # later in your code: my $mask = initialmask($nfactors); do { # blah blah blah $mask } while (nextmask($mask));
Not quite as space-efficient as bitstrings, and it doesn't quite generalize as easily if there are duplicates in your "set", but pretty fast. Of course, if you're taking $mask apart I strongly recommend switching to "0" and "1", (instead of \x00 and \xff) since it makes the regular expressions significantly more readable.
-- @/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/