How do I abstract multiple nested loops?

Question

Given, slicing an array into p parts of size ≥ 1 each:

my @a = 'A'..'F';

# p = 1
my @p1 = [@a];
# ["A" .. "F"]

# p = 2
my @p2;
for my $x (0..@a-2) {
    push @p2, [
        [@a[0..$x]],
        [@a[$x+1..@a-1]],
    ];
}
# [["A"], ["B" .. "F"]],
# [["A", "B"], ["C" .. "F"]],
# [["A", "B", "C"], ["D", "E", "F"]],
# [["A" .. "D"], ["E", "F"]],
# [["A" .. "E"], ["F"]],


# p = 3
my @p3;
for my $x (0..@a-3) {
    for my $y ($x+1..@a-2) {
        push @p3, [
            [@a[0..$x]],
            [@a[$x+1..$y]],
            [@a[$y+1..@a-1]],
        ];
    }
}
# [["A"], ["B"], ["C" .. "F"]],
# [["A"], ["B", "C"], ["D", "E", "F"]],
# [["A"], ["B", "C", "D"], ["E", "F"]],
# [["A"], ["B" .. "E"], ["F"]],
# [["A", "B"], ["C"], ["D", "E", "F"]],
# [["A", "B"], ["C", "D"], ["E", "F"]],
# [["A", "B"], ["C", "D", "E"], ["F"]],
# [["A", "B", "C"], ["D"], ["E", "F"]],
# [["A", "B", "C"], ["D", "E"], ["F"]],
# [["A" .. "D"], ["E"], ["F"]],


# p = 4
my @p4;
for my $x (0..@a-4) {
    for my $y ($x+1..@a-3) {
        for my $z ($y+1..@a-2) {
            push @p4, [
                [@a[0..$x]],
                [@a[$x+1..$y]],
                [@a[$y+1..$z]],
                [@a[$z+1..@a-1]],
            ];
        }
    }
}
# [["A"], ["B"], ["C"], ["D", "E", "F"]],
# [["A"], ["B"], ["C", "D"], ["E", "F"]],
# [["A"], ["B"], ["C", "D", "E"], ["F"]],
# [["A"], ["B", "C"], ["D"], ["E", "F"]],
# [["A"], ["B", "C"], ["D", "E"], ["F"]],
# [["A"], ["B", "C", "D"], ["E"], ["F"]],
# [["A", "B"], ["C"], ["D"], ["E", "F"]],
# [["A", "B"], ["C"], ["D", "E"], ["F"]],
# [["A", "B"], ["C", "D"], ["E"], ["F"]],
# [["A", "B", "C"], ["D"], ["E"], ["F"]],

How do I abstract out the increasing number of nested loops to turn it into a sub slices(Int $p, Array @a)? I guess I need some sort of higher-order foreach.

Answer 1

You may look for a recursive solution?

For p = 1 slices just returns all of the items together. For p > 1 it takes the first n items and joins the items for p - 1 for each 1 <= n < the number of items.

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dump qw(dump);

my @a = 'A' .. 'F';

for (my $i = 1; $i <= 4; $i++) {
  warn("p = $i\n");
  dump(slices($i, @a));
};

sub slices
{
  my $p = shift();
  my @a = @_;

  my @ret;

  if ($p == 1) {
    push(@ret, [[@a]]);
  }
  else {
    for (my $i = 0; $i < $#a; $i++) {
      foreach (slices($p - 1, @a[($i + 1) .. $#a])) {
        push(@ret, [([@a[0 .. $i]], @{$_})]);
      }
      # or shorter:
      #push(@ret, map({[([@a[0 .. $i]], @{$_})]} slices($p - 1, @a[($i + 1) .. $#a])));
    }
  }

  return @ret;
}

Output:

p = 1
[["A" .. "F"]]
p = 2
(
  [["A"], ["B" .. "F"]],
  [["A", "B"], ["C" .. "F"]],
  [["A", "B", "C"], ["D", "E", "F"]],
  [["A" .. "D"], ["E", "F"]],
  [["A" .. "E"], ["F"]],
)
p = 3
(
  [["A"], ["B"], ["C" .. "F"]],
  [["A"], ["B", "C"], ["D", "E", "F"]],
  [["A"], ["B", "C", "D"], ["E", "F"]],
  [["A"], ["B" .. "E"], ["F"]],
  [["A", "B"], ["C"], ["D", "E", "F"]],
  [["A", "B"], ["C", "D"], ["E", "F"]],
  [["A", "B"], ["C", "D", "E"], ["F"]],
  [["A", "B", "C"], ["D"], ["E", "F"]],
  [["A", "B", "C"], ["D", "E"], ["F"]],
  [["A" .. "D"], ["E"], ["F"]],
)
p = 4
(
  [["A"], ["B"], ["C"], ["D", "E", "F"]],
  [["A"], ["B"], ["C", "D"], ["E", "F"]],
  [["A"], ["B"], ["C", "D", "E"], ["F"]],
  [["A"], ["B", "C"], ["D"], ["E", "F"]],
  [["A"], ["B", "C"], ["D", "E"], ["F"]],
  [["A"], ["B", "C", "D"], ["E"], ["F"]],
  [["A", "B"], ["C"], ["D"], ["E", "F"]],
  [["A", "B"], ["C"], ["D", "E"], ["F"]],
  [["A", "B"], ["C", "D"], ["E"], ["F"]],
  [["A", "B", "C"], ["D"], ["E"], ["F"]],
)

(Might need some tweaks. Like checking that 1 <= p <= number of items.)

Answer 2

You want Algorithm::Loop's NestedLoops when you need an arbitrary number of nested loops.

use Algorithm::Loops qw( NestedLoops );

sub list_segments {
   my ($array, $p) = @_;

   my $iter = NestedLoops([
      [ 0 ],
      ( map { my $d = $_;   sub { [ $_+1 .. @$array-($p-$d) ] }   } 1 .. $p-1 ),
      [ 0+@$array ],
   ]);

   return sub {
      my @split_points = $iter->()
         or return ();

      return [
         map [ @$array[ $split_points[$_] .. $split_points[$_+1]-1 ] ],
            0..$#split_points-1
      ];
   };
}

This can be tested using the following:

use Data::Dump qw( dd );

my $iter = list_segments(['A'..'F'], 3);
while ( my $list_segments = $iter->() ) {
   dd($list_segments);
}

Output:

[["A"], ["B"], ["C" .. "F"]]
[["A"], ["B", "C"], ["D", "E", "F"]]
[["A"], ["B", "C", "D"], ["E", "F"]]
[["A"], ["B" .. "E"], ["F"]]
[["A", "B"], ["C"], ["D", "E", "F"]]
[["A", "B"], ["C", "D"], ["E", "F"]]
[["A", "B"], ["C", "D", "E"], ["F"]]
[["A", "B", "C"], ["D"], ["E", "F"]]
[["A", "B", "C"], ["D", "E"], ["F"]]
[["A" .. "D"], ["E"], ["F"]]

---

By the way, an easy way to test solutions is to compare the number of results against C(N-1, p-1) = (N-1)! / (N-p)! / (p-1)! since you're effectively choosing p-1 split points from the N-1 possible split points.