Weekly Challenge 201

Challenge 201

Task One

You are given an array of unique numbers. Write a script to find out all missing numbers in the range 0..$n where $n is the array size.

Task Two

Write a script to determine the number of ways of putting $n pennies in a row of piles of ascending heights from left to right. i.e. List all distinct partitions of n.
My solutions on github

Solution to Task One

At first I thought there was a typo because there are always going to be some missing numbers. Taking advantage of smart match:

use v5.30.0;
no warnings "experimental";
my @array = (0,1,3);
my @list;
say "Input: (" . join(",",@array).")";
print "Output: ";
for (0..scalar @array) {
    push @list, $_ unless ($_ ~~ @array);
}
say join(",", @list);

I figured this was ripe for a one-liner:
print for grep {!($_ ~~ @ARGV)} (0 .. @ARGV)

Solution to Task Two

This took a lot of debugging. More smart match action. I chose to start with the largest partition of n (1 + 1 + ... + 1 = n) and started adding each pair of terms, including it in our collection if it was an ascending sequence. This was my third attempt: I initially started from the bottom (starting with n and subtracting to create (1, n-1) and (2, n-2) etc.); then I considered generating all possible partitions and filtering the ascending ones.

use v5.30.0;
no warnings "experimental";
my $n = $ARGV[0] || 5;
say "Input: \$n = $n";
print "Output: " ;
my @set = (join(" ",(1) x $n));
my $i=-1;
do {
    $i++;
    rout($set[$i]);
    @set = grep { defined($_) } @set;    
} until (length $set[$i] <= 3);
my $length = @set;
do {
    rout($set[$i]);
    $i++;
} while ($i < $length);
push @set, $n;
say scalar @set;
say foreach @set;
sub rout {
    my $s = shift;
    my @a = split(" ", $s);
    return "no" if (@a <= 2);
    if ($a[$#a] != 1) {
    for (1 .. @a - 2) {
        my $str = chonk($_, @a);
        push @set, $str unless ($str ~~ @set);
    }
    }
    my $str = chonk(0, @a);
    push @set, $str unless ($str ~~ @set);
}
sub chonk {         #add two elems, given offset.
    my ($offset, @a) = @_;
    my $num = $a[$#a - $offset] + $a[$#a - $offset - 1];
    splice @a, $#a - $offset - 1, 2, $num;
    my $bad_cnt;
    for (1.. $#a) {
    $bad_cnt++ if ($a[$_ - 1] > $a[$_]);
    }
    return if ($bad_cnt);
    return join(" ",@a);
}