This is my response to the Perl Weekly Challenge #071.
$N (>1).
$N with random unique
elements between 1 and 50.
Array: [ 18, 45, 38, 25, 10, 7, 21, 6, 28, 48 ]
Peak: [ 48, 45, 21 ]
Array: [ 47, 11, 32, 8, 1, 9, 39, 14, 36, 23 ]
Peak: [ 47, 32, 39, 36 ]
The first part is handling the input ($N), and
generating a random array. The challenge doesn't actually
say that the values in the array should be integers, but we
can deduce that from the examples.
#! /usr/bin/env raku
subset VeryPosInt of Int where * >= 1; # [1]
unit sub MAIN (VeryPosInt $N, :$v, :$verbose = $v); # [2]
my @array = (1..50).roll($N); # [3]
say ": Values: @array[]" if $verbose; # [4]
[1] We use a custom type (set up with subset)
to ensure that $N is an integer, with the value 2 or higher.
[2] Note the «--verbose» and «--v» shortcut.
[3] From the array (1..50) pick a value at random
(with roll), $N times.
[4] Verbose mode comes in handy here, to show that we get it right.
Do not use
pick here, as it explicitly avoids repetitions. We do want
repetetitions in our array.
See docs.raku.org/language/typesystem#index-entry-subset-subset for more information about «subset».
See
docs.raku.org/routine/roll
for more information about roll.
See
docs.raku.org/routine/pick
for more information about pick.
Choosing the values to keep is simple; compare each one with the one to the left and the one to the right. But what about the very first and very last value?
The start and end values need special care, as they do not have two neighbours. We can fix that by starting with the second element, and go on until the last but one, when we do the comparisons.
File: peak-element-if (the rest)
my @peak; # [5]
for ^$N-> $index # [6]
{
if $index == 0 # [7]
{
say ": Checking at index $index: (value: @array[$index], \
right:@array[$index+1])" if $verbose;
@peak.push: @array[$index] if @array[$index] > @array[$index+1];
}
elsif $index <= $N -2 # [8]
{
say ": Checking at index $index: (left:@array[$index-1], \
value: @array[$index], right:@array[$index+1])" if $verbose;
@peak.push: @array[$index] if @array[$index] > @array[$index-1]
&& @array[$index] > @array[$index+1];
}
else # if $index == $N -2 # [9]
{
say ": Checking at index $index: (left:@array[$index-1], \
value: @array[$index])" if $verbose;
@peak.push: @array[$index] if @array[$index] > @array[$index-1];
}
}
say "[ ", @peak.join(", "), " ]";
[5] We will collect the peak elements here.
[6] For each element in the random array,
[7] • Special case the first.
[8] • The middle (where there are two neighbours).
[9] • The last.
The first element in the list has index (offset) 0, so the first one with a neighbour on the left hand side has index 1.
The number of elements in the list is $N. The last element has index
$N -1. The last one with a neighbour on the right hand side
has index $N -2.
Running it:
$ ./peak-element-if 4
[ ]
$ ./peak-element-if 10
[ 36, 29 ]
$ ./peak-element-if 10
[ 44, 47, 47 ]
Running it with verbose mode makes it possible to see what is going on:
$ ./peak-element-if -v 2
: Values: 49 29
: Checking at position 1: (left:-1, value: 49, right:29)
: Checking at position 2: (left:49, value: 29, right:-1)
[ 49 ]
$ ./peak-element-if -v 4
: Values: 17 23 21 4
: Checking at position 1: (left:-1, value: 17, right:23)
: Checking at position 2: (left:17, value: 23, right:21)
: Checking at position 3: (left:23, value: 21, right:4)
: Checking at position 4: (left:21, value: 4, right:-1)
[ 23 ]
$ ./peak-element-if -v 4
: Values: 49 20 17 30
: Checking at position 1: (left:-1, value: 49, right:20)
: Checking at position 2: (left:49, value: 20, right:17)
: Checking at position 3: (left:20, value: 17, right:30)
: Checking at position 4: (left:17, value: 30, right:-1)
[ 49, 30 ]
Looking good.
We can get rid of the if-mess, with a little care:
#! /usr/bin/env raku
subset VeryPosInt of Int where * > 1;
unit sub MAIN (VeryPosInt $N, :$v, :$verbose = $v);
my @array = (1..50).roll($N);
say ": Values: @array[]" if $verbose;
@array.push: -1; # [1]
@array.unshift: -1; # [1]
my @peak;
for 1 .. $N -> $index # [2]
{
say ": Checking at position $index: (left:@array[$index-1], \
value: @array[$index], right:@array[$index+1])" if $verbose;
@peak.push: @array[$index] if @array[$index] > @array[$index-1]
&& @array[$index] > @array[$index+1];
}
say "[ ", @peak.join(", "), " ]";
[1] Add a new value at both ends of the array (push adds at the end,
and unshift adds at the beginning - in front of the original values).
[2] Note the modified index limits.
Note that I have changed the verbose output slightly. Insted of the index (starting with 0), it now shows the position (starting with 1). This simplifies the code.
Running it shows that it works just as well as the previous version:
$ ./peak-element -v 2
: Values: 46 17
: Checking at position 1: (left:-1, value: 46, right:17)
: Checking at position 2: (left:46, value: 17, right:-1)
[ 46 ]
./peak-element -v 4
: Values: 38 26 31 22
: Checking at position 1: (left:-1, value: 38, right:26)
: Checking at position 2: (left:38, value: 26, right:31)
: Checking at position 3: (left:26, value: 31, right:22)
: Checking at position 4: (left:31, value: 22, right:-1)
[ 38, 31 ]
Note that verbose mode now shows the -1 values.
It is easy to remove those values, if it bothers you. (It doesn't
bother me.)
#! /usr/bin/env perl
use strict;
use feature 'say';
my $N = shift(@ARGV) // die 'Please specify $N';
my $verbose;
if ($N eq "--verbose" || $N eq "--v")
{
$verbose++;
$N = shift(@ARGV) // die 'Please specify $N';
}
die '$N must be an integer >= 1' unless int($N) == $N && $N >= 1;
my @array;
push(@array, int(rand(50) +1)) for 1 .. $N; # [1]
say ": Values: " , join(", ", @array) if $verbose;
my @peak;
push(@array, -1);
unshift(@array, -1);
for my $index (1 .. $N)
{
say ": Checking at position $index: (left:" . $array[$index-1] .
", value: " . $array[$index] . ", right:" . $array[$index+1] . ")"
if $verbose;
push(@peak, @array[$index]) if $array[$index] > $array[$index-1]
&& $array[$index] > $array[$index+1];
}
say "[ ", join(", ", @peak), " ]";
[1] The Raku version is much nicer. We can simplify (for a given value of «simple»)
this Perl line (together with the previous one) with map:
# my @array;
# push(@array, int(rand(50) +1)) for 1 .. $N;
my @array = map { int(rand(50) +1) } for 1 .. $N;
Running it:
./peak-element-perl --v 2
: Values: 41, 4
: Checking at position 1: (left:-1, value: 41, right:4)
: Checking at position 2: (left:41, value: 4, right:-1)
[ 41 ]
./peak-element-perl --v 4
: Values: 46, 37, 21, 21
: Checking at position 1: (left:-1, value: 46, right:37)
: Checking at position 2: (left:46, value: 37, right:21)
: Checking at position 3: (left:37, value: 21, right:21)
: Checking at position 4: (left:21, value: 21, right:-1)
[ 46 ]
$N (>0).
$Nth node from the end of the linked list
and print the linked list.
$N is greater than the size of the linked list then remove the first
node of the list.
Given Linked List: 1 -> 2 -> 3 -> 4 -> 5
when $N = 1
Output: 1 -> 2 -> 3 -> 4
when $N = 2
Output: 1 -> 2 -> 3 -> 5
when $N = 3
Output: 1 -> 2 -> 4 -> 5
when $N = 4
Output: 1 -> 3 -> 4 -> 5
when $N = 5
Output: 2 -> 3 -> 4 -> 5
when $N = 6
Output: 2 -> 3 -> 4 -> 5
First a non-working version using a class and methods only:
File: tll-class-wrong
#! /usr/bin/env raku
subset PosInt of Int where * >= 1;
unit sub MAIN (PosInt $N, :$v, :$verbose = :$v);
class LinkedElement # [1]
{
has $.value; # [2]
has $.next is rw; # [3]
method print-list # [4]
{
print self.value; # [4a]
if self.next # [4b]
{
print " -> "; # [4c]
self.next.print-list; # [4d]
}
else # [4e]
{
print "\n"; # [4f]
}
}
method list-length # [5]
{
my $length = 1;
my $current = self.next;
while ($current)
{
$current = $current.next;
$length++;
}
return $length;
}
method remove-from-end($from-the-end) # [6]
{
my $length = self.list-length;
if $length == 1
{
die "[]";
}
elsif $from-the-end > $length
{
self = self.next;
}
else
{
my $current = self;
for 1 .. ($length - $from-the-end -1)
{
$current = $current.next;
}
$current.next = $current.next.next;
}
}
}
my $length = (1..50).pick; # [7]
my $head; # [8]
my $current; # [9]
for 1..$length -> $value # [10]
{
my $new = LinkedElement.new(value => $value); # [10a]
if $current # [12]
{
$current.next = $new; # [12a]
$current = $current.next; # [12b]
}
else # Initially # [11]
{
$head = $new; # [11a]
$current = $head; # [11b]
}
}
$head.print-list;
say "Length: ", $head.list-length if $verbose;
$head.remove-from-end($N);
$head.print-list;
[1] A class for an element in the list,
[2] with a value (shown as consecutive integers in the challenge), so that we can see what is going on after deleting something.
[3] A pointer to the next value. We have only links in one direction, as
specified in the challenge. Note the is rw so that we can change
the value after we have created the object. This makes it possible to generate
objects from the first one, and then add new ones on to the end until we have
the full length.
[4] We need a way of printing the list. This recursive method does just that. It starts by printing the value of the current element [4a], then if it has a neighbour [4b], print the required arrow [4c] and invoke itself on that neighbour [4d]. If not, end the output with a newline and we are done.
[5] We are asked to remove an element counted from the end. This is easier to do if we know the length, so this method does just that. It follows the list, counting the elements as it goes along, and returns that length. We need this method, as the length is not known to the list itself.
[6] Remove the element. First get the length. If the requested element is before the first one (or the first one), remove that. (Except that it fails, as we'll see below.) If it somewhere inside the list, we count along to the right position, and deletes the node.
[7] The length of the array is a random value, between 1 and 50, just to make it more exciting. And unpredictable.
[8] Pointer to the first node in the linked list.
[9] The current pointer, used when we generate the list.
[10] Loop through the values to add to the linked list, and generate the objects [10a].
[11] If this is the first element we generate, set the head and current variables.
[12] If not, add it as the next element of the current pointer, and set the current pointer to this new element, ready for the next iteration.
Let us try:
./tll-class-wrong 16
1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> 8 -> 9 -> 10 -> 11 -> 12 -> 13 -> 14 \
-> 15 -> 16 -> 17 -> 18 -> 19 -> 20 -> 21 -> 22
Length: 22
1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 8 -> 9 -> 10 -> 11 -> 12 -> 13 -> 14 -> 15 \
-> 16 -> 17 -> 18 -> 19 -> 20 -> 21 -> 22
$ ./tll-class-wrong 99
1 -> 2 -> 3 -> 4
Length: 4
Cannot modify an immutable LinkedElement (LinkedElement.new(va...)
in method remove-from-end at ./tll-class-wrong line 50
in sub MAIN at ./tll-class-wrong line 93
in block <unit> at ./tll-class-wrong line 3
The problem is that self is a pointer to the current element.
And it is read only, so we cannot change it. As we just tried to do..
We can fix this by trickery:
File: tll-class
#! /usr/bin/env raku
subset PosInt of Int where * >= 1;
unit sub MAIN (PosInt $N, :$v, :$verbose = :$v);
class LinkedElement
{
has $.value is rw; # [2]
has $.next is rw;
method print-list
{
print self.value;
if self.next
{
print " -> ";
self.next.print-list;
}
else
{
print "\n";
}
}
method list-length
{
my $length = 1;
my $current = self.next;
while ($current)
{
$current = $current.next;
$length++;
}
return $length;
}
method remove-from-end($from-the-end)
{
my $length = self.list-length;
if $length == 1
{
die "[]";
}
elsif $from-the-end > $length
{
self.value = self.next.value; # [1]
self.next = self.next.next; # [1]
}
else
{
my $current = self;
for 1 .. ($length - $from-the-end -1)
{
$current = $current.next;
}
$current.next = $current.next.next;
}
}
}
my $length = (1..50).pick;
my $head;
my $current;
for 1..$length -> $value
{
my $new = LinkedElement.new(value => $value);
if $current
{
$current.next = $new;
$current = $current.next;
}
else # Initially
{
$head = $new;
$current = $head;
}
}
$head.print-list;
say "Length: ", $head.list-length if $verbose;
$head.remove-from-end($N);
$head.print-list;
[1] We cannot change self itself (pun intended), but we can change the object
attributes. Which we do; let the head take over the second elements value, and remove that
from the list.
[2] We have to make the value changeable (with is rw) for this to work.
We are messing around with the value of the first object in the linked list, and that is cheating. It works, but that does not change the fact that it is cheating.
Replacing the offending method with a procedure solves the problem. But it does not look very nice, and the object encapsulation has gone.
File: tll-hybrid
#! /usr/bin/env raku
subset PosInt of Int where * >= 1;
unit sub MAIN (PosInt $N, :$v, :$verbose = :$v, :$limit = 50);
class LinkedElement
{
has $.value is rw;
has $.next is rw;
method print-list
{
print self.value;
if self.next
{
print " -> ";
self.next.print-list;
}
else
{
print "\n";
}
}
method list-length
{
my $length = 1;
my $current = self.next;
while ($current)
{
$current = $current.next;
$length++;
}
return $length;
}
}
my $length = (1..$limit).pick;
my $head;
my $current;
for 1..$length -> $value
{
my $new = LinkedElement.new(value => $value);
if $current
{
$current.next = $new;
$current = $current.next;
}
else # Initially
{
$head = $new;
$current = $head;
}
}
say $head.raku;
$head.print-list;
say "Length: ", $head.list-length if $verbose;
remove-element($head, $N);
$head # [1]
?? $head.print-list
!! say "[]";
sub remove-element ($list is rw, $from-the-end)
{
my $length = $list.list-length;
if $from-the-end > $length
{
$list = $list.next;
}
else
{
my $current = $list;
for 1 .. ($length - $from-the-end -1)
{
$current = $current.next;
}
$current.next = $current.next.next;
}
}
[1] An alternate way of handling an empty list.
It is possible to call the procedure with an alternate «method look-alike
syntax», with a dot and and ampersand (.&), if that makes you happier:
# remove-element($head, $N);
$head.&remove-element($N);
See
docs.raku.org/language/operators#methodop_.&
for more information about the special procedure invocation syntax .&.
Here is a version where all the methods have been replaced by procedures:
File: tll-proc
#! /usr/bin/env raku
subset PosInt of Int where * >= 1;
unit sub MAIN (PosInt $N, :$v, :$verbose = :$v);
class LinkedElement
{
has $.value;
has $.next is rw;
}
my $length = (1..50).pick;
my $head;
my $current;
for 1..$length -> $value
{
my $new = LinkedElement.new(value => $value);
if $current
{
$current.next = $new;
$current = $current.next;
}
else # Initially
{
$head = $new;
$current = $head;
}
}
say $head.raku;
print-list($head);
sub print-list ($list)
{
print $list.value;
if $list.next
{
print " -> ";
print-list($list.next);
}
else
{
print "\n";
}
}
sub get-list-length ($list)
{
return 0 unless $list;
my $length = 1;
$current = $list.next;
while ($current)
{
$current = $current.next;
$length++;
}
return $length;
}
say "Length: ", get-list-length($head) if $verbose;
remove-element($head, $N);
print-list($head);
sub remove-element ($list is rw, $from-the-end)
{
my $length = get-list-length($list);
if $from-the-end > $length
{
$list = $list.next;
}
else
{
my $current = $list;
for 1 .. ($length - $from-the-end -1)
{
$current = $current.next;
}
$current.next = $current.next.next;
}
}
Say goodbye to object encapsulation. We could make the code more robust by adding type constraints on the procedure arguments. E.g.
# sub print-list ($list)
sub print-list (LinkedElement $list)
But using methods in(side) the class is much better.
And that's it.