perl - 如何抽象多个嵌套循环？

Question

给定，将数组切片为 p 个大小≥ 1 的部分:

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"]],

我如何抽象出越来越多的嵌套循环以将其变成子 slices(Int $p, Array @a) ?我想我需要某种高阶 foreach .

Answer 1

你要Algorithm::Loop的 NestedLoops当您需要任意数量的嵌套循环时。

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
      ];
   };
}

这可以使用以下方法进行测试:

use Data::Dump qw( dd );

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

输出:

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

顺便说一句，测试解决方案的一种简单方法是将结果数量与 C(N-1, p-1) = (N-1) 进行比较!/(N-P)!/(p-1)!因为您实际上是从 N-1 个可能的分割点中选择 p-1 个分割点。