Perl; How to avoid severely nested foreach loops

Question

I want to cycle through 12 strings, and list every combination of them, for example I have shorted the working code for 3 terms:

foreach my $t1 ('a', 0) {
    foreach my $t2 ('b', 0) {
        foreach my $t3 ('c', 0) {
            my @terms = grep {$_ ne '0'} ($t1, $t2, $t3);
            say join ('+', @terms);
        }
    }
}

which outputs

a+b+c
a+b
a+c
a
b+c
b
c

This is the correct output.

However, I realize that deep nesting of foreach loops isn't good coding practice.

I have looked at alternatives to this in Alternate looping nested foreach loops but this requires this is also really ugly:

my @t1 = ("a", (0) x 132);
my @t2 = ("b", (0) x 132);
my @t3 = ("c", (0) x 132);
my @t4 = ("d", (0) x 132);
my @t5 = ("e", (0) x 132);
my @t6 = ("f", (0) x 132);
my @t7 = ("g", (0) x 132);
my @t8 = ("h", (0) x 132);
my @t9 = ("i", (0) x 132);
my @t10 = ("j", (0) x 132);
my @t11 = ("k", (0) x 132);
my @t12 = ("l", (0) x 132);

my $it = each_array(@t1, @t2, @t3, @t4, @t5, @t6, @t7, @t8, @t9, @t10, @t11, @t12);
while (my ($t1, $t2, $t3, $t4, $t5, $t6, $t7, $t8, $t9, $t10, $t11, $t12) = $it->()) {
    my @terms = grep {$_ ne '0'} ($t1, $t2, $t3, $t4, $t5, $t6, $t7, $t8, $t9, $t10, $t11, $t12);
    say join ('+', @terms);
}

this just outputs blank spaces, and doesn't seem to do what I think each_array is supposed to do. I'm not even sure that there will be 132 iterations.

How can I go through these 12 terms without deep nesting of foreach loops?

Answer 1

You are looking for the non-empty subsets.

---

When you have an arbitrary number of nested loops, you can use Algorithm::Loops's NestedLoops.

use Algorithm::Loops qw( NestedLoops );

my @syms = 'a'..'c';
#my @syms = 'a'..'l';

NestedLoops(
   [ map [ $_, undef ], @syms ],
   sub {
      @_ = grep defined, @_;
      say join "+", @_ if @_;
   }
);

NestedLoops can also be used to generate an iterator.

my $iter = NestedLoops([
   map [ $_, undef ], @syms
]);
while ( my @subset = $iter->() ) {
   @subset = grep defined, @subset;
   say join "+", @subset if @subset;
}

---

Algorithm::Combinatorics's subsets is a specialized solution to this problem.

use Algorithm::Combinatorics qw( subsets );

my $syms = [ 'a'..'c' ];
#my $syms = [ 'a'..'l' ];

my $iter = subsets($syms);
while ( my $subset = $iter->next() ) {
   say join "+", @$subset if @$subset;
}

Thanks to @larsen for suggesting this approach.

---

A solution to this problem can be implemented trivially by counting up to 2^N-1 with each bit indicating the presence or absence of a symbol.

my @syms = 'a'..'c';
#my @syms = 'a'..'l';

my @masks = map { 1 << $_ } 0..$#syms;

for my $n ( 1 .. 2**@syms-1 ) {
   say join "+", map { $n & $masks[$_] ? $syms[$_] : () } 0..$#syms;
}

Answer 2

It looks like you want Algorithm::Combinatorics, more specifically the subsets subroutine (your example does not correspond to the definition of combinations).