tasks a-s

Task/Ordered-Partitions/Perl/ordered-partitions-1.pl

@@ -0,0 +1,43 @@
+use Thread 'async';
+use Thread::Queue;
+
+sub make_slices {
+        my ($n, @avail) = (shift, @{ +shift });
+
+        my ($q, @part, $gen);
+        $gen = sub {
+                my $pos = shift;        # where to start in the list
+                if (@part == $n) {
+                        # we accumulated enough for a partition, emit them and
+                        # wait for main thread to pick them up, then back up
+                        $q->enqueue(\@part, \@avail);
+                        return;
+                }
+
+                # obviously not enough elements left to make a partition, back up
+                return if (@part + @avail < $n);
+
+                for my $i ($pos .. @avail - 1) {                # try each in turn
+                        push @part, splice @avail, $i, 1;       # take one
+                        $gen->($i);                             # go deeper
+                        splice @avail, $i, 0, pop @part;        # put it back
+                }
+        };
+
+        $q = new Thread::Queue;
+        (async{ &$gen;                  # start the main work load
+                $q->enqueue(undef)      # signal that there's no more data
+        })->detach;     # let the thread clean up after itself, not my problem
+
+        return $q;
+}
+
+my $qa = make_slices(4, [ 0 .. 9 ]);
+while (my $a = $qa->dequeue) {
+        my $qb = make_slices(2, $qa->dequeue);
+
+        while (my $b = $qb->dequeue) {
+                my $rb = $qb->dequeue;
+                print "@$a | @$b | @$rb\n";
+        }
+}

Task/Ordered-Partitions/Perl/ordered-partitions-2.pl

@@ -0,0 +1,48 @@
+sub partitions {
+        my $sum = 0;
+        $sum += $_ for @_;              # total number of elements
+        make_part (     $_[-1],         # desired partition size
+                        0,              # initial trial position
+                        [ (0) x $sum ], # table recording of used element
+                        [],             # current pick for current partition
+                        [       $#_,    # total number of partitions
+                                \@_,    # partition sizes
+                                []      # for output, each partition's elements
+                        ]               # Note: last group of args wrapped in array ref
+        );                              #       to reduce argument passing overhead
+}
+
+sub make_part {
+        my ($n, $pos, $used, $picked, $more) = @_;
+        return if $pos > @$used;
+
+        # the making-next-partition part
+        if (!$n) {
+                my ($part_idx, $sizes, $q) = @$more;
+                push @$q, $picked;
+                if ($part_idx > 1) {
+                        make_part($sizes->[$part_idx-1], 0, $used, [],
+                                        [ $part_idx-1, $sizes, $q]);
+                } else {
+                        my @x = grep { !$used->[$_] } 0 .. (@$used-1);
+                        print "[ @$_ ]" for @$q;
+                        print "[ @x ]\n";
+                }
+                pop @$q;
+                return;
+        }
+
+        # the picking-element-to-make-partition part
+        for my $i ($pos .. @$used - 1) {
+                next if $used->[$i];
+                push @$picked, $i;
+                $used->[$i] = 1;
+
+                make_part($n - 1, $i + 1, $used, $picked, $more);
+
+                $used->[$i] = 0;
+                pop @$picked;
+        }
+}
+
+partitions(4, 2, 4);