This is my response to the Perl Weekly Challenge #080.
@N.
Input: @N = (5, 2, -2, 0)
Output: 1
Input: @N = (1, 8, -1)
Output: 2
Input: @N = (2, 0, -1)
Output: 1
The challenge ask for the Smallest Positive Number, but it is clear (from the examples) that it should have asked for the Smallest Positive Integer.
File: smallest-positive-integer
#! /usr/bin/env raku
unit sub MAIN (*@N where @N.elems > 0 && all(@N) ~~ Int, # [1]
:v(:$verbose));
my @positively_sorted = @N.grep( * > 0 ).sort.squish; # [2]
say ": Positively Sorted: { @positively_sorted.join(", ") }" if $verbose;
my $expected = 1; # [3]
for @positively_sorted -> $current # [4]
{
say ": Current value: $current - expected $expected" if $verbose;
last if $current != $expected; # [5]
$expected++; # [6]
}
say $expected; # [7]
[1] Ensure at least one element in the list (.elems > 0), and that all
of them are integers (all(@N) ~~ Int).
[2]
We are looking for the lowest positive integer the is missing. We
start by getting rid of integers below the limit (grep( * > 0 )). Then
we sort the list (sort), so that the lowest value comes first. The
challenge does not exclude the possibility of duplicate values, so we remove them
(with squish, as the list is sorted. On an unsorted list, use
unique instead).
[3] The first value we expect (in the sequence 1,2,3..Inf) is 1.
[4] Iterate over the values.
[5] Exit the loop if the value does not meet our expectations.
[6] Be ready for the next value in the loop, which should be the next integer.
[7] Print the expected value.
See
docs.raku.org/routine/squish for
more information about squish
See
docs.raku.org/routine/unique for
more information about unique
Running it with the examples:
$ ./smallest-positive-integer 5 2 -2 -0
1
$ ./smallest-positive-integer 1 8 -1
2
$ ./smallest-positive-integer 2 0 -1
1
With verbose mode:
$ ./smallest-positive-integer -v 5 2 -2 -0
: Positively Sorted: 2, 5
: Current value: 2 - expected 1
1
$ ./smallest-positive-integer -v 1 8 -1
: Positively Sorted: 1, 8
: Current value: 1 - expected 1
: Current value: 8 - expected 2
2
$ ./smallest-positive-integer -v 2 0 -1
: Positively Sorted: 2
: Current value: 2 - expected 1
1
It is possible to argue that the list
@N = (1, 2, 3, 4, 5) has no missing values. The challenge does not discuss
that possibility (i.e. what to do in that case), so I simply assume that the very next
value is missing (which is 6 in this case).
$ ./smallest-positive-integer 1 2 3 4 5
6
$ ./smallest-positive-integer -v 1 2 3 4 5
: Positively Sorted: 1, 2, 3, 4, 5
: Current value: 1 - expected 1
: Current value: 2 - expected 2
: Current value: 3 - expected 3
: Current value: 4 - expected 4
: Current value: 5 - expected 5
6
#! /usr/bin/env perl
use Perl6::Junction 'all';
use List::MoreUtils qw(uniq);
use Getopt::Long;
use feature 'say';
use strict;
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my @A = @ARGV;
die "Please specify at least one element" unless @A;
die "Integers only" unless all(@A) == qr/^\d+$/;
my @positively_sorted = uniq sort { $a <=> $b } grep { $_ > 0 } @A;
say ": Positively Sorted: " . join(", ", @positively_sorted) if $verbose;
my $expected = 1;
for my $current (@positively_sorted)
{
say ": Current value: $current - expected $expected" if $verbose;
last if $current != $expected;
$expected++;
}
say $expected;
The { $a <=> $b } argument to sort is there to enforce
numeric sorting, instead of the default lexicographic order (as text). The number
«10» shows up where it should be. Drop the argument block, and it will pop up after
the «1» instead.
$ ./smallest-positive-integer-perl -v 1 2 4 5 3 1 10
: Positively Sorted: 1, 2, 3, 4, 5, 10
: Current value: 1 - expected 1
: Current value: 2 - expected 2
: Current value: 3 - expected 3
: Current value: 4 - expected 4
: Current value: 5 - expected 5
: Current value: 10 - expected 6
6
@N candidates.
Input: @N = (1, 2, 2)
Output: 4
Input: @N = (1, 4, 3, 2)
Output: 7
The explanation for the second example got it wrong: «The second candidate gets two more candies as it's ranking is higher than it's both neighbour.» The value is correct, but the reason is that the third candidate (ranking 3) has a candy count of 2, so we arrive at 3 as we have to exceed that:
: Ranking: 1, 4, 3, 2
: Candies: 1, 3, 2, 1
: Ranking: 1, 4, 3, 2
: Candies: 1, 1, 1, 1 # Initially
: Candies: 1, 1, 1, 1 # 1
: Candies: 1, 2, 1, 1 # 2
: Candies: 1, 2, 2, 1 # 3
: Candies: 1, 2, 2, 1 # 4
: Candies: 1, 2, 2, 1 # Result
: Candies: 1, 3, 2, 1 # Expected
The problem is that the second candidate must get one extra candy, but we do not know that before calculating the number of candies for the third candidate. And the number of candies for the third candidate depends on the number of candies for the fourth candidate.
A right-to-left approach has the same problem, but not necessarily on the same rankings.
A program using this approach, «count-candies-wrong», is available in the zip file.
It is tiresome to special case the left hand and the right
hand candidates (as they only have one neighbour), so I have added dummy candidates at both
ends of @N. The ranking is set to Inf for both of them, so that
they don't mess up the calculation when we calculate the candy count for a neighbouring
candidate (the original left and right hand candidates in the array).
#! /usr/bin/env raku
unit sub MAIN (*@N where @N.elems > 0 && all(@N) ~~ Int, # [1]
:v(:$verbose));
my @C = 1 xx @N.elems; # [2]
@N.push: Inf; @N.unshift: Inf; # [3]
@C.push: 0; @C.unshift: 0; # [3]
say ": \@N Ranking w/border: { @N.join(", ") }" if $verbose;
say ": \@C Candies w/border: { @C.join(", ") }" if $verbose;
loop # [4]
{
say ": Loop" if $verbose;
my $changes = 0; # [5]
for 1 .. @N.end -1 -> $index # [6]
{
if @N[$index] > @N[$index-1] && @C[$index] <= @C[$index-1] # [7]
{
@C[$index]++; # [8]
$changes++; # [9]
say ": \@C Candies w/border: { @C.join(", ") } (left) Iteration:$loop"
if $verbose;
}
if @N[$index] > @N[$index+1] && @C[$index] <= @C[$index+1] # [10]
{
@C[$index]++; # [11]
$changes++; # [12]
say ": \@C Candies w/border: { @C.join(", ") } (right) Iteration:$loop"
if $verbose;
}
}
last if $changes == 0; # [13]
}
if $verbose
{
say ": \@N Ranking: { @N[1..@N.end -1].join(", ") }";
say ": \@C Candies: { @C[1..@N.end -1].join(", ") }";
}
say @C.sum; # [14]
[1] Ensure at least one value, and it (or they) must all be integers.
[2] We store the candy count here, starting with 1 for each one.
[3] Add dummy values at the left (unshift) and right
(push) of the real elements.
[4] An eternal loop (but see [13]).
[5] The number of changes in this iteration.
[6] Iterate over the real values (i.e. excluding the dummies added in [3], or rather the indices.
[7] If the rank of the current candidate is higher than the one to the left, and the candy count does not reflect that,
[8] • add a candy.
[9] • note that we have changed a value.
[10] As [7], but compared with the one on the right.
[11] as [8].
[12] as [9].
[13] Exit the (eternal) loop if we have a full iteration without any changes. Then we are done.
[14] Print the sum. Note the usage of 0 as the value for the dummy
entries (in @C), so that we can add the whole array together.
Running it on the examples gives the correct answers:
$ ./count-candies-loop 1 2 2
4
$ ./count-candies-loop 1 4 3 2
7
With verbose mode:
$ ./count-candies-loop -v 1 2 2
: @N Ranking w/border: Inf, 1, 2, 2, Inf
: @C Candies w/border: 0, 1, 1, 1, 0
: @C Candies w/border: 0, 1, 2, 1, 0 (left) Iteration:1
: @N Ranking: 1, 2, 2
: @C Candies: 1, 2, 1
4
$ ./count-candies-loop -v 1 4 3 2
: @N Ranking w/border: Inf, 1, 4, 3, 2, Inf
: @C Candies w/border: 0, 1, 1, 1, 1, 0
: @C Candies w/border: 0, 1, 2, 1, 1, 0 (left) Iteration:1
: @C Candies w/border: 0, 1, 2, 2, 1, 0 (right) Iteration:1
: @C Candies w/border: 0, 1, 3, 2, 1, 0 (right) Iteration:2
: @N Ranking: 1, 4, 3, 2
: @C Candies: 1, 3, 2, 1
7
The first example needed one iteration only to arrive at the result. The second iteration did not change enything, and the loop was terminated.
The second example needed two iterations.
We can get a way with a single pass, if we do them in sorted order (with the lowest rank first).
File: count-candies-sort
#! /usr/bin/env raku
unit sub MAIN (*@N where @N.elems > 0 && all(@N) ~~ Int, :v(:$verbose));
my @C = 1 xx @N.elems; # [7]
@N.push: Inf; @N.unshift: Inf;
@C.push: 0; @C.unshift: 0; # [7]
my %M = (0..@N.end).map({ $_ => @N[$_] }); # [1]
for %M.keys.sort({ %M{$^a} <=> %M{$^b} }) -> $index # [2]
{
@C[$index] = candy-count($index); # [3]
say ": Index $index with value %M{$index} and candies @C[$index]"
if $verbose;
}
if $verbose
{
say ": Ranking2: { @N.join(", ") }";
say ": Candies2: { @C.join(", ") }";
say ": Ranking: { @N[1..@N.end -1].join(", ") }";
say ": Candies: { @C[1..@N.end -1].join(", ") }";
}
say @C.sum;
sub candy-count ($index) # [3]
{
return 0 if $index == 0|@N.end; # [4]
return max(@C[$index-1], @C[$index+1]) +1
if @N[$index] > @N[$index-1] || @N[$index] > @N[$index+1]; # [5]
return 1; # [6]
}
[1] We need the rankings sorted, but with the original order intact. So we set
up this mapping hash, with the index in @N as key, and the ranking
as value. We do it this way, as keys have to be unique, and array indices are.
[2] Then we iterate over the keys from [1], sorted by the value (we must explicitly
ask for numeric sorting, as numbers obtained from the command line will be sorted
as strings by default. Look up the IntStr type for details) with
the lowest first.
[3] Then we fill in the number of candies, which will be correct as the neighbours can only get the same or a higher candy count later on - and that will not afffect this candidate's count.
[4] The dummy candidates (at both ends) get no candy.
[5] If the rank is higher than one (or both) neighbours', return the highest of those neighbours increased by one.
[6] Default to 1.
[7] We could have skipped the intitialisation, as all the entries in @C
will be explicitly assigned a value by the for loop ([2]).
Running it on the examples gives the correct answers. Here it is with verbose mode:
$ ./count-candies-sort -v 1 2 2
: Index 1 with value 1 and candies 1
: Index 2 with value 2 and candies 2
: Index 3 with value 2 and candies 1
: Index 0 with value Inf and candies 0
: Index 4 with value Inf and candies 0
: Ranking w/border: Inf, 1, 2, 2, Inf
: Candies w/border: 0, 1, 2, 1, 0
: Ranking: 1, 2, 2
: Candies: 1, 2, 1
4
$ ./count-candies-sort -v 1 4 3 2
: Index 1 with value 1 and candies 1
: Index 4 with value 2 and candies 1
: Index 3 with value 3 and candies 2
: Index 2 with value 4 and candies 3
: Index 0 with value Inf and candies 0
: Index 5 with value Inf and candies 0
: Ranking w/border: Inf, 1, 4, 3, 2, Inf
: Candies w/border: 0, 1, 3, 2, 1, 0
: Ranking: 1, 4, 3, 2
: Candies: 1, 3, 2, 1
7
#! /usr/bin/env perl
use strict;
use bigrat; # -> inf
use feature 'signatures';
use Perl6::Junction 'all';
use List::Util qw/sum max/;
use Getopt::Long;
use feature 'say';
no warnings qw(experimental::signatures);
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my @N = @ARGV;
die "Please specify at least one element" unless @N;
die "Integers only" unless all(@N) == qr/^\d+$/;
push(@N, inf); unshift(@N, inf);
my %M = map { $_ => $N[$_] } 0 .. (@N -1);
my @C = (); ## x (length(@N));
my $N_end = @N -2;
for my $index (sort { $M{$a} <=> $M{$b} } keys %M)
{
$C[$index] = candy_count($index);
say ": Index $index with value $M{$index} and candies $C[$index]"
if $verbose;
}
if ($verbose)
{
say ": Ranking w/border: " . join(", ", @N);
say ": Candies w/border: " . join(", ", @C);
say ": Ranking: " . join(", ", @N[1..$N_end]);
say ": Candies: " . join(", ", @C[1..$N_end]);
}
say sum(@C);
sub candy_count ($index)
{
return 0 if $index == 0 || $index == @N -1;
return max($C[$index-1], $C[$index+1]) +1
if $N[$index] > $N[$index-1] || $N[$index] > $N[$index+1];
return 1;
}
Running it gives the expected result, here with verbose mode:
$ ./count-candies-sort-perl -v 1 2 2
: Ranking w/border: inf, 1, 2, 2, inf
: Candies w/border:
: Index 1 with value 1 and candies 1
: Index 3 with value 2 and candies 1
: Index 2 with value 2 and candies 2
: Index 4 with value inf and candies 0
: Index 0 with value inf and candies 0
: Ranking w/border: inf, 1, 2, 2, inf
: Candies w/border: 0, 1, 2, 1, 0
: Ranking: 1, 2, 2
: Candies: 1, 2, 1
4
$ ./count-candies-sort-perl -v 1 4 3 2
: Ranking w/border: inf, 1, 4, 3, 2, inf
: Candies w/border:
: Index 1 with value 1 and candies 1
: Index 4 with value 2 and candies 1
: Index 3 with value 3 and candies 2
: Index 2 with value 4 and candies 3
: Index 0 with value inf and candies 0
: Index 5 with value inf and candies 0
: Ranking w/border: inf, 1, 4, 3, 2, inf
: Candies w/border: 0, 1, 3, 2, 1, 0
: Ranking: 1, 4, 3, 2
: Candies: 1, 3, 2, 1
7
And that's it.