Traversing Peaks for the Missing Link

Wherein we move back and forth, studying the lay of the land, selecting that which once was whole to be now unmoored and left floating to be collected…

THE WEEKLY CHALLENGE – PERL & RAKU #71

TASK #1 › Peak Element

Submitted by: Mohammad S Anwar

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 ]

Method

Iterating through an array by index, comparing each value to the indices one below and one higher, is only really complicated by the two values at either end of the array. For those we need to make a special case because there are no elements on the outside to compare. On the high end autovivification will create a new element for us, although we might get a warning doing a numeric comparison on an undefined value, but on the low end subtracting 1 from 0 gives us an index of [-1], which will give us the value of the last element to compare to. That’s just not going to work.

We can get around this by bracketing our random array with 0s, at index 0 and again above the end. After all, it doesn’t matter what the index range actually is, per se. We could even remove them after the fact should we wish to. But there is no need for that, because we can refer to our original array by a slice. Here it is in Perl:

@arr[1..@arr-2]

Normally the index of our last element is the length of the array – 1, so to exclude the additional 0 that value now becomes -2.

Perl Solution

in Perl, I originally constructed the comparison in a for loop:

for my $idx (1..@arr-1) {
    if ( $arr[$idx] > $arr[$idx-1] && $arr[$idx] > $arr[$idx+1] ) {
        push @output, $arr[$idx];
    }
}

This was straightforward and satisfactory, albeit a bit unsatisfying. So I said to myself: “Why not write some functions to apply some other functions over some data?” It seems an obvious question, if you’re a bit of a weirdo. We already know how to slice the indices to get our array; why not start with those? We can use grep to check and filter on the comparisons, then map to transform the indices into values. Now it feels so… clean. (spoiler alert: if gets even cleaner in Raku)

[colincrain:~PWC]$  perl 71_1_peak_power.pl 10
input array: 41 12 20 27 25 29 50 37 9 35
peak values: 41 27 50 35

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my $n = shift @ARGV // 10;

## make a list of n unique numbers
## --> encapsulating the arr in 0s  
##     makes the comparisons at the ends easy
my @pool = (1..50);
my @arr = (0);
push @arr, splice( @pool, int(rand(@pool)) , 1 ) while (@arr < $n+1);
push @arr, 0;

say "input array: @arr[1..@arr-2]";

my @output = map  { $arr[$_] } 
             grep { ($arr[$_-1] < $arr[$_] && $arr[$_] > $arr[$_+1]) }
             (1..@arr-2);
           
say "peak values: @output";

Raku Solution

As mentioned above, in Raku things get even cleaner. Browsing through the Haskell to Raku Migration docs, I noticed a tidbit in the list comprehensions section that caught my eye:

 my @evens = map { $_ if $_ %% 2 }, 0..100;

List comprehensions are one the few language constructs out there in the world that I really miss in Perl. Not too much, mind you, because there are always a variety of other ways to get the same thing done. But fortunately, the Raku team have improved this situation, by making this particular, intuitive construction work properly.¹

So after refactoring as a pseudo list comprehension, the filter gets rolled into a single map as

    my @output = (1..^@a.end)
                .map: { @a[$_] if @a[$_-1] < @a[$_] && @a[$_] > @a[$_+1] };

Which works perfectly.

---

¹ Note this doesn’t quite work in Perl, as the elements that do not pass the condition still remain, albeit undefined, keeping the array length unchanged. Those elements would need to be filtered with something like grep {defined $_}.

---

[colincrain:~/PWC]$  raku 71-1-peak-power.raku 10
input array: 46 37 24 2 22 16 40 44 34 1
peak values: 46 22 44 

sub MAIN (Int $n where {$n > 0} = 10 ) {

    # create our random array:
    #   bookending the arr in 0s  
    #   makes the comparisons at the ends cleaner
    my @a = 0, |(1..50).pick($n), 0 ;

    say "input array: @a[1..@a-2]";

    ## the indices for the original array elements
    ## map back to their array values iff comparison passes
    my @output = (1..^@a.end)
                .map: { @a[$_] if @a[$_-1] < @a[$_] && @a[$_] > @a[$_+1] };

    say "peak values: ", @output.join: ' '; 
    
}

---

---

TASK #2 › Trim Linked List

Submitted by: Mohammad S Anwar

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

Method

Right out of the gate, identifying a node by its proximity to the end of a linked list just doesn’t sound like a very “linked list” sort of thing to do, especially when considered alongside Perl arrays. I mean, a Perl array already knows its length by definition, and indexed access to an array of data references make this job trivial. But no matter. Sometimes you have to do what you have to do. It could come up, and so let’s go ahead and figure out a way to do it.

A singly linked list has, by definition, no idea of its length, and no inherent idea of its terminating node. By traversing the list, the end node can be identified as having no next link, but once that is done, there is no way to walk the list backwards to trace those nodes above it. So we’re starting with the deck stacked against us, so to speak. Not to belabor the point, but it seems that should we really need to perform this action repeatedly, it probably would be worth the effort to start with either a doubly linked list or perhaps a different data structure completely. But again, no mind. We do what we do. Such is life.

So how can we identify the n-th node from the end to remove it?

Well, pretty much the only thing we can do is look forward from one node to the next. And as noted, if a given node has no next node, that identifies the end of the list. So if we were to look forward a set number of times and see that there was no next node, then we would know we were at a certain number of places in front of the end. That’s certainly a start.

Actually because we can only look forward to the next node, rather than backwards to the node that links to a given node, any unlinking of a node must be made from the position one before the one we wish to unlink. Then we link that node to the target node’s next and poof! the target is bypassed. This only requires minor adjustment to the math, to count one more, but also complicates things should we wish to unlink the first node. We’ll need to make a special case for that, which we will also apply whenever we simply cannot look ahead sufficiently far, as when the position requested is larger than the list itself. In either case the list object itself has a starting attribute, pointing to the first node of the list. This acts as our 0th position, and removing the first node involves pointing to what was the second node and unlinking to the first.

Our lookahead routine therefore needs to return one of three states:

1. Yes, I found the end of the list
2. No, I did not yet find the end of the list
3. I just can’t even. We ran out of road before looking far enough, and are now sailing headlong off into the Grand Canyon like Thelma and Louise. Or perhaps we’ve simply stopped and returned. I can see it both ways.

Depending on the return value, we can start our routine at the beginning of the list, checking nodes one by one and advancing until we find the n+1th node from the end and remove the following link. Or remove the first link, as the case may be.

Perl Solution

As we are asked specifically to provide a “pure” linked list implementation, I decided to augment the simple Node object I had constructed for previous challenges with a proper LinkedList container package to hold our Nodes. This holds meta-information such as the starting node and a collection of methods for things lists might wish to do, such as load data from an array or pretty print output. Because the node removal routines were generalized list-y actions I made them methods too. The lookahead routine, on the other hand, is something that Nodes might wish to do within lists, so that method belongs to them. Then again perhaps it’s specific to this task and should stand apart, I don’t know. It is awfully specific. But I see no harm with it being where it is, so there it remains.

One more thing – some of you may have noticed the

while ( -looking_ahead ) { ... }

and wondered what that was all about. I recently came across this construction and decided to include it. Essentially this is just while (1) { ... } loop, and the reason it resolves is detailed in perlop:

• Unary “-” performs arithmetic negation if the operand is numeric, including any string that looks like a number. If the operand is an identifier, a string consisting of a minus sign concatenated with the identifier is returned. Otherwise, if the string starts with a plus or minus, a string starting with the opposite sign is returned. One effect of these rules is that -bareword is equivalent to the string “-bareword”.

All this allows one the opportunity to add a helpful comment instead of a simple 1 or such. And comments are always welcome, at least when they’re helpful.

[colincrain:~/PWC]$  perl 71-2-missing_link2.pl 4 A B C D E F G
input  A B C D E F G
target 4
----------------------------------

A → B → C → D → E → F → G
A → B → C → E → F → G

use warnings;
use strict;
use feature ":5.26";
use Moo;

## ## ## ## ## ## ## ## ## ## ## ## ## ## ## CLASSES:

package Node;
use Moo;

    has value => ( is => 'rw' );
    has next  => ( is => 'rw' );

    sub terminate {
        $_[0]->{value} = undef;
    }
    
    sub lookahead {
    ## looks forward n nodes in list 
    ## returns:  1 if node is not last node
    ##           0 if node is last node
    ##          -1 if list not long enough 
        my ($self, $distance) = @_;
        if (! defined $self->next && $distance > 0) {
            return -1;
        }
        if ($distance == 0) { 
            return $self->next ? 1 : 0;       
        }
        return lookahead($self->next, $distance - 1);
    }



package LinkedList;
use Moo;

    has 'start_node' => ( is => 'rw' );

    sub populate_from_array  {
    ## convert array into a linked list
    ## sets start_node
        my ($self, @input) = @_;
        my ($node, $next);
        while (scalar @input > 0) {
            my $value =  pop @input;
            $node = new Node(value => $value, next => $next);
            $next = $node;
        }
        $self->start_node($node);
    }

    sub arrow_print {
    ## pretty print the list
        my $self = shift;
        my $node = $self->start_node;

        my @output;
        while (defined $node) {
            push @output, $node->value;
            $node = $node->next;
    
        }
        say join ' → ', @output;
    }
    
    sub remove_next {
    ## splices out the next node and relinks
        my ($self, $node) = @_;
        my $unlinked = $node->next;
        $node->next( $node->next->next );
        $unlinked->terminate;
    }
    
    sub remove_head {
    ## remove the starting node and resets start to second node
        my $self = shift;
        my $unlink = $self->start_node;
        $self->start_node($self->start_node->next);
        $unlink->terminate;
    }


## ## ## ## ## ## ## ## ## ## ## ## ## ## ## MAIN:

package main;
use Node;
use LinkedList;

my ($n, @input) = @ARGV;
say "input  @input
target $n
----------------------------------
";

my $list = new LinkedList;
$list->populate_from_array(@input);
$list->arrow_print;

## unlink the n-th node from the end
my $node = $list->start_node;
while ( -looking_ahead ) {
    my $res = $node->lookahead( $n ) ;
    if ( $res < 1 ) {
        $res ==  0 && $list->remove_next($node);
        $res == -1 && $list->remove_head;
        last;
    }
    $node = $node->next;
}

$list->arrow_print;

Raku Solution

The Raku solution follows the logical system of the Perl, so save syntax remains much the same. One nice addition was that the use of the given/when block within the lookahead structure makes that block flow very pleasantly well.

[colincrain:~/PWC]$  raku 71-2-missing-link.raku 1 A B C
A → B → C
A → B
[colincrain:~/PWC]$  raku 71-2-missing-link.raku 2 A B C
A → B → C
A → C
[colincrain:~/PWC]$  raku 71-2-missing-link.raku 3 A B C
A → B → C
B → C
[colincrain:~/PWC]$  raku 71-2-missing-link.raku 4 A B C
A → B → C
B → C

class Node {
    has Any  $.value is rw;
    has Node $.next  is rw;
    
    method terminate {
        $.next = Nil
    }
    
    method lookahead ( Int $distance ) {
    ## looks forward n nodes in list 
    ## returns:
    ## 1 if node is not last node
    ## 0 if node is last node
    ## -1 if list not long enough 
        when ! $.next.defined && $distance > 0 { return -1 }
        when $distance == 0 && $.next.defined  { return  1 }
        when $distance == 0                    { return  0 }
    
        return $.next.lookahead($distance - 1);
    }

}

class LinkedList {
    has Node $.first is rw;
    has Node $!last;                     
    
    method populate_from_array ( @array ) {
        my $node;
        my $next;
        while @array.elems > 0 {
            $node = Node.new(value => @array.pop);
            $!last //= $node;
            $node.next = $next if $next.defined;
            $next = $node;
        }
        $.first = $node;
    }
    
    method arrow_print () {
        my @output;
        my $node = $.first;
        loop {
            @output.push: $node.value;
            last if ! $node.next.defined;
            $node = $node.next;
        }
        @output.join(' → ').say;
    }  
    
    method remove_next ( Node $node ) {
    ## splices out the next node and relinks around
        return unless $node.next;
        my $x = $node.next;
        $node.next = $node.next.next;
        $x.terminate;
    }
    
    method remove_head {
    ## remove the first node and resets first to second node
        my $x = $.first;
        $.first = $x.next;
        $x.terminate;
    }

}

multi MAIN () {
    say "Usage: ./missing-link.raku [location] a1 a2 a3 ...
            location > 0";
}

multi MAIN ( Int $n where { $n > 0 }, *@array ) {

    ## convert the input commandline array into a linked list
    my $list = LinkedList.new;
    $list.populate_from_array( @array );
    $list.arrow_print;
    
    ## unlink the n-th node from the end
    my $node = $list.first;

 LOOK:
    loop {
        given $node.lookahead( $n ) {
            when  0  { $list.remove_next( $node ); last LOOK }
            when -1  { $list.remove_head;          last LOOK }
            $node = $node.next;
        }
    }

    $list.arrow_print;
}