laurent_r

These are some answers to the Week 71 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Peak Elements

You are given positive integer $N (>1).

Write a script to create an array of size $N with random unique elements between 1 and 50.

In the end it should print peak elements in the array, if found.

An array element is called peak if it is bigger than it’s neighbour.

Example 1:

Array: [ 18, 45, 38, 25, 10, 7, 21, 6, 28, 48 ]
Peak: [ 48, 45, 21 ]

Example 2:

Array: [ 47, 11, 32, 8, 1, 9, 39, 14, 36, 23 ]
Peak: [ 47, 32, 39, 36 ]

The specification somewhat lacks precision, but the examples are clear enough to clarify.

Peak Elements in Raku

In Raku, the pick built-in method provides (pseudo-)random unique elements from a list or a range. It is then just a matter of comparing each item with its predecessor and its successor, and to add the first item of the list if it is larger than the second one, and the last item if it is larger than the one before the last.

use v6;

sub MAIN (Int $n where 1 < * <= 50) {
    my @nums = (1..50).pick: $n;
    say @nums;
    my @peaks = gather {
        for 1..^@nums.end -> $i {
            take @nums[$i] if @nums[$i-1] < @nums[$i] > @nums[$i+1];
        }
    }
    unshift @peaks, @nums[0] if @nums[1] < @nums[0];
    push @peaks, @nums[@nums.end] 
        if @nums[@nums.end] > @nums[@nums.end -1];
    say @peaks;
}

These are a few sample runs of this program:

$ raku peak.raku 10
[33 35 4 20 2 16 7 31 23 46]
[35 20 16 31 46]
-
$ raku peak.raku 10
[32 34 30 48 14 50 17 12 26 5]
[34 48 50 26]
-
$ raku peak.raku 10
[15 4 31 49 16 14 23 5 26 17]
[15 49 23 26]
-
$ raku peak.raku 10
[4 40 28 46 43 33 49 1 15 18]
[40 46 49 18]
-
$ raku peak.raku 40
[19 12 30 46 27 15 14 41 43 3 17 32 48 10 18 24 26 37 33 28 35 40 22 9 23 39 29 8 47 1 2 49 34 42 44 16 4 38 21 31]
[19 46 43 48 37 40 39 47 49 44 38 31]
-
$ raku peak.raku 40
[40 10 7 32 44 5 4 29 16 49 30 28 38 35 46 45 11 6 47 8 26 18 34 13 23 19 50 12 43 37 25 17 33 31 42 36 9 15 39 2]
[40 44 29 49 38 46 47 26 34 23 50 43 33 42 39]
-
$ raku peak.raku 45
[47 8 31 46 35 19 17 23 43 41 7 6 24 45 34 3 32 2 22 18 29 26 42 40 49 48 13 11 44 30 12 4 9 20 21 10 15 36 50 14 39 33 1 5 27]
[47 46 43 45 32 22 29 42 49 44 21 50 39 27]

Peak Elements in Perl

Perl doesn’t have a built-in pick function to provide random unique elements from a list or a range. The Perl rand function returns a (pseudo)-random fractional number greater than or equal to 0 and less than the value of the parameter passed to it. So, to get a random integer between 1 and 50, we need something like this:

my $element = int(rand(50) + 1);

To ensure that the random numbers are unique, we use the %unique hash which enables us to remove any duplicate from the list.

The rest of the program is essentially a port to Perl of the Raku program: we loop through the list of random integers and keep those which are larger than their predecessors and successors, and we add the first item of the list if it is larger than the second one, and the last item if it is larger than its predecessor.

use strict;
use warnings;
use feature qw /say/;

my $n = shift;
my %unique;
my @items;
while (%unique < $n) {
    my $element = int(rand(50) + 1);
    push @items, $element unless exists $unique{$element};
    $unique{$element} = 1
}

say "Original list: @items";
my @peaks;
push @peaks, $items[0] if $items[0] > $items[1];
for my $i (1..$#items - 1) {
    push @peaks, $items[$i] if $items[$i] > $items[$i-1] 
        and $items[$i] > $items[$i+1];
}
push @peaks, $items[-1] if $items[-1] > $items[-2];
say "Peaks: @peaks";

This is the output of a few sample runs:

$ perl peak.pl 10
Original list: 14 11 23 37 17 20 40 47 29 7
Peaks: 14 37 47

$ perl peak.pl 10
Original list: 43 48 28 35 8 36 11 39 4 29
Peaks: 48 35 36 39 29

$ perl peak.pl 20
Original list: 20 4 30 25 1 2 41 39 24 17 3 44 29 49 8 34 13 28 12 38
Peaks: 20 30 41 44 49 34 28 38

$ perl peak.pl 3
Original list: 10 23 12
Peaks: 23

$ perl peak.pl 49
Original list: 13 32 24 40 28 34 39 15 43 29 42 5 6 46 9 27 12 3 33 30 2 23 11 48 17 20 10 8 50 4 45 36 26 37 1 41 21 35 31 18 16 49 44 19 14 7 47 25 38
Peaks: 32 40 39 43 42 46 27 33 23 48 20 50 45 37 41 35 49 47 38

Task 2: Trim Linked List

You are given a singly linked list and a positive integer $N (>0).

Write a script to remove the $Nth node from the end of the linked list and print the linked list.

If $N is greater than the size of the linked list then remove the first node of the list.

NOTE: Please use pure linked list implementation.

Example:

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

I don’t know why Mohammad keeps suggesting challenges with linked lists, which are essentially useless both in Perl and in Raku: both languages have dynamic arrays which offer essentially all the services offered by linked lists in lower-level languages such as C. In fact, except possibly for pedagogical purpose, I strongly object to the very idea of implementing linked lists in Perl or in Raku.

So, I’ll implement a pure linked list implementation in Raku, since this is part of the specification, using an object oriented design, but I’ll willfully cheat and use built-in arrays for the details, because this is my view the right way to remove an item from a collection.

My program implements a Node class defining a simple node structure (with a value and a link to the next node), and a Linkedlist class holding the head of the linked list and defining a make-array method to transform the linked list into an array. There is also a gist method to provide a string representation of the linked list (the overloaded gist method is used by the say routine). The code also has a build-linked-list subroutine to transform an array into a linked list. The idea of the program is to transform a linked list into an array, to remove the desired item from the array, and to convert the array back into a new linked list.

use v6;

class Node {
    has $.value is rw;
    has $.next is rw;
}
class Linkedlist {
    has Node $.head;
    method make-array () {
        my $node = $.head;
        my @array = $node.value;
        while $node.next:defined {
            $node = $node.next;
            push @array, $node.value;
        }
    return @array;
    }
  method gist () {
        my @a = | $.make-array;
        return join ' -> ', @a;
    }
}
sub build-linked-list (@values is copy) {
    my $last = @values[*-1];
    my @nodes;
    my $tail = Node.new( value => $last, next => Nil);
    @nodes[$last] = $tail;
    for @values[1..@values.end].keys.reverse -> $i {
        my $node = Node.new( value => @values[$i], 
            next => @nodes[@values[$i+1]]);
        @nodes[@values[$i]] = $node;
    }
    return Linkedlist.new( head => @nodes[@values[0]]);
}

sub MAIN (Int $n) {
    my @start_range = 1..5;
    my $linked_list = build-linked-list @start_range;
    say "Original list: ", $linked_list;
    my @a = $linked_list.make-array;
    my @new_range = @start_range;
    if $n >= @a.elems {
        shift @new_range;
    } else {
        @new_range[@new_range.end - $n +1]:delete;
    }
    @new_range = grep {.defined }, @new_range;
    my $next_linked_list = build-linked-list @new_range;
    say "New linked list: ", $next_linked_list;
}

This is the output for a few test cases:

$ raku linked_list.raku 7
Original list: 1 -> 2 -> 3 -> 4 -> 5
New linked list: 2 -> 3 -> 4 -> 5

$ raku linked_list.raku 3
Original list: 1 -> 2 -> 3 -> 4 -> 5
New linked list: 1 -> 2 -> 4 -> 5

$ raku linked_list.raku 1
Original list: 1 -> 2 -> 3 -> 4 -> 5
New linked list: 1 -> 2 -> 3 -> 4

$ raku linked_list.raku 2
Original list: 1 -> 2 -> 3 -> 4 -> 5
New linked list: 1 -> 2 -> 3 -> 5

$ raku linked_list.raku 5
Original list: 1 -> 2 -> 3 -> 4 -> 5
New linked list: 2 -> 3 -> 4 -> 5

As said earlier, I don’t think it is right to implement linked lists in Raku or Perl. I nonetheless did it in Raku to show my good will. But I still think this is a deadly wrong idea. Therefore, I will decline to answer the task in Perl (I have shown in earlier challenges that I know how to do it if needed, it is really the fact that I object to it that leads me to that decision).

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, August 9, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.