Perl Weekly Challenge 80: Smallest Positive Number Bits and Count Candies
These are some answers to the Week 80 of the Perl Weekly Challenge organized by Mohammad S. Anwar
Spoiler Alert: This weekly challenge deadline is due in several days (October 4, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.
Task 1: Smallest Positive Number Bits
You are given unsorted list of integers @N.
Write a script to find out the smallest positive number missing.
Example 1:
Input: @N = (5, 2, -2, 0)
Output: 1
Example 2:
Input: @N = (1, 8, -1)
Output: 2
Example 3:
Input: @N = (2, 0, -1)
Output: 1
Smallest Positive Integer Missing in Raku
Our program receives the list of numbers as a parameter (or takes a default list of integers if none is provided). It removes any negative values, sorts the remaining integers, and remove any duplicate (although removing duplicates is not strictly necessary). It then loops through the sorted array, picks the first gap (missing value) into the $result variable and exits the loop. Then it prints the value of result if it is defined, or the last value of the sorted array + 1 if $result is not defined (i.e. if no gap was found).
use v6;
my @nums = @*ARGS.elems > 1 ?? @*ARGS !! (5, 2, -2, 0);
my @sorted = @nums.grep(* >= 0).sort({$^a <=> $^b}).squish;
die "No solution with given input!" if @sorted.elems < 1;
my $result;
for 0..@sorted.end-1 -> $i {
$result = (@sorted[$i] + 1) and last
if @sorted[$i] + 1 < @sorted[$i+1];
}
say $result.defined ?? $result !! @sorted[*-1] + 1;
Of course, a real life program should probably perform some input validation, but a real life program is not very likely to get its input from the command line.
These are the results displayed for a few input lists of integers:
$ raku smallest-missing.raku
1
$ raku smallest-missing.raku 1 8 -1
2
$ raku smallest-missing.raku 2 0 -1
1
$ raku smallest-missing.raku 1 4 3 2 5 8 7 9 4 4 3 2
6
Smallest Positive Integer Missing in Perl
This is a Perl port of the Raku program above (except that it does not remove duplicates). Please refer to the previous section for explanations on how it works.
use strict;
use warnings;
use feature qw /say/;
my @nums = @ARGV > 1 ? @ARGV : (5, 2, -2, 0);
my @sorted = sort { $a <=> $b } grep $_ >= 0, @nums;
die "No solution with given input!" if @sorted < 1;
my $result;
for my $i (0..scalar @nums - 1) {
$result = ($sorted[$i] + 1) and last
if $sorted[$i] + 1 < $sorted[$i+1];
}
say $sorted[-1] + 1 and exit unless defined $result;
say $result ;
The program displays the expected results for a few input list of integers:
$ perl smallest-missing.pl
1
$ perl smallest-missing.pl 1 8 -1
2
$ perl smallest-missing.pl 2 0 -1
1
$ perl smallest-missing.pl 1 4 3 2 5 8 7 9
6
Task 2: Count Candies
You are given rankings of @N candidates.
Write a script to find out the total candies needed for all candidates. You are asked to follow the rules below:
a) You must given at least one candy to each candidate.
b) Candidate with higher ranking get more candies than their immediate neighbors on either side.
Example 1:
Input: @N = (1, 2, 2)
Explanation:
Applying rule #a, each candidate will get one candy. So total candies needed so far 3. Now applying rule #b, the first candidate do not get any more candy as its rank is lower than it's neighbours. The second candidate gets one more candy as it's ranking is higher than it's neighbour. Finally the third candidate do not get any extra candy as it's ranking is not higher than neighbour. Therefore total candies required is 4.
Output: 4
Example 2:
Input: @N = (1, 4, 3, 2)
Explanation:
Applying rule #a, each candidate will get one candy. So total candies needed so far 4. Now applying rule #b, the first candidate do not get any more candy as its rank is lower than it's neighbours. The second candidate gets two more candies as it's ranking is higher than it's both neighbour. The third candidate gets one more candy as it's ranking is higher than it's neighbour. Finally the fourth candidate do not get any extra candy as it's ranking is not higher than neighbour. Therefore total candies required is 7.
Output: 7
Candy Count in Raku
Here, we use an array of three arrays of integers. For each sub-array, we first set $count to the number of values in the sub-array (rule #a), and then loop through the sub-array and increment $count for each neighbor that is smaller than the current value.
use v6;
my @n = [1, 2, 2], [1, 4, 3, 2], [<3 1 5 8 7 4 2>];;
for @n -> @nums {
my $count = @nums.elems;
for 0..@nums.end -> $i {
$count++ if defined @nums[$i+$_] and
@nums[$i] > @nums[$i+$_] for -1, 1;
}
say "Total candies required for [@nums[]]: $count.";
}
This program displays the following (correct) output:
raku ./candy_count.raku
Total candies required for [1 2 2]: 4.
Total candies required for [1 4 3 2]: 7.
Total candies required for [3 1 5 8 7 4 2]: 13.
Candy Count in Perl
This is a port to Perl of the Raku program above. Please refer to the explanations in the previous section. As a side note, I was somewhat unhappy some six years ago when I discovered that you cannot get the last element of an array using the -1 subscript in Raku as you would do in Perl ($array[-1]), but would need to use the whatever operator (@array[*-1]). While porting my script to Perl, I initially had a bug, because $num_ref->[$i+$j] was defined (the last item in the array) when $i+$j took the -1 value. This is why I had to add a next statement when $i + $j took a negative value. So, after all, Perl seemed more expressive, but it turns out that Raku is slightly more consistent and a bit less dangerous in such cases.
use strict;
use warnings;
use feature qw /say/;
my @n = ([1, 2, 2], [1, 4, 3, 2], [qw<3 1 5 8 7 4 2>]);
for my $num_ref (@n) {
my $count = scalar @$num_ref;
for my $i (0..$#$num_ref) {
for my $j (-1, 1) {
next if $i + $j < 0; # avoid negative subscripts
$count++ if (defined $num_ref->[$i+$j]) and
$num_ref->[$i] > $num_ref->[$i+$j];
}
}
say "Total candies required for [@$num_ref]: $count.";
}
This program displays the same output as the Raku program:
$ perl candy_count.pl
Total candies required for [1 2 2]: 4.
Total candies required for [1 4 3 2]: 7.
Total candies required for [3 1 5 8 7 4 2]: 13.
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, October 11, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.
I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.