Weekly Challenge 201
Zapwai
Posted on January 25, 2023
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);
}
Posted on January 25, 2023
Join Our Newsletter. No Spam, Only the good stuff.
Sign up to receive the latest update from our blog.