🦋 108. Basic usage of NativeCall in Perl 6

NativeCall is both a module and a technology in Perl 6 that allows you to call C functions from your Perl 6 code. Today, let’s meet the most basic usage.

Take the rand() function from the C standard library:

#include <stdio.h>
#include <stdlib.h>

int main() {    
    int r = rand();
    printf("%i\n", r);

    return 0;
}

If you are used to Perl, it may be a surprise that the program actually prints the same number every time you call it. (That’s a kind of surprise of forgotten knowledge.) Compile and run:

$ gcc rand.c

$ ./a.out 
16807

$ ./a.out 
16807

Now let’s call C’s rand() from Perl 6. Refer to the documentation of NativeCall to see the options it offers.

Your Perl 6 program may look like this:

use NativeCall;

sub c_rand() returns int32 is native('c') is symbol('rand') {*}

say c_rand();

Although the rand() function was chosen as one from the standard library that do not need parameters, the choice added a few small complications to the Perl 6 code. But it is good that we can demonstrate them all together.

Similarly to how you declare external functions in C, you need to tell Perl 6 that there is some function that it should load from an external library. The name of the library is passed in the native trait. Its argument, c, will be converted to libc, and the corresponding shared library will be searched for in the standard places on your computer.

The symbol trait tells us the original function name. It is a bit weird to me, but Rakudo cannot handle the following code where you use the same name as in C:

use NativeCall;

sub rand() returns int32 is native('c') {*}

say rand();

This is how you would declare an external C function if you didn’t want to rename it in your program. Unfortunately, Perl 6 also has rand, and we got an error:

===SORRY!=== Error while compiling rand.pl6
 Unsupported use of rand(); in Perl 6 please use rand
 at rand.pl6:5
 ------> say rand⏏();

Finally, returns int32 tells that the function returns a native 32-bit integer.

Another surprise pops up when you run our Perl 6 program. It returns a random value, and that value is different each time you call it:

$ perl6 rand.pl6 
1790432239

$ perl6 rand.pl6 
1431059869

Is it really working? It is random, but why it does not copy the behaviour of the reference C program?

Does Rakudo call srand when it starts up? A shallow investigation gives the following log comment:

nqp/MoarVM/docs/ChangeLog:+ Do not call srand() if not using rand()

Let’s go back to our test case. To make sure it works, let us create our own version of the function, which will be returning the same value again and again:

myrand.c:

int myrand() {
    return 42;
}

myrand.h:

int myrand();

Test it in pure C first:

#include "myrand.h"
#include <stdio.h>

int main() {
    int r = myrand();
    printf("%i\n", r);

    return 0;
}
$ gcc myrand-main.c myrand.c 

$ ./a.out 
42

$ ./a.out 
42

It works. Now use it from Perl 6, and the program is almost the same as before:

use NativeCall;

sub myrand() returns int32 is native('libmyrand.so') {*}

say myrand();

The main differences are the name of the function (there is no clash with Perl 6 built-in functions, and thus no need to introduce an alias) and the library name, which is a file name this time.

(This is how you create a shared library:)

$ gcc -shared -olibmyrand.so myrand.c 

If you run the updated Perl 6 program, you will only see 42 in the output.

$ perl6 myrand.pl6 
42

$ perl6 myrand.pl6 
42

This confirms that the returns int32 clause works correctly, and the value returned from the C library is understood by Perl 6.

💡 107. Odd-even sort in Perl 6

In the Odd-Even sort, or Brick sort, you take every second element and swap it with the next one if they are not sorted. Then you take the same elements and swap it with the previous element if they are not ordered. You continue until you are done.

You can formulate the algorithm a bit differently, and then you will clearly have odd and even elements: first, you compare odd elements with its neighbours, then you compare even elements. If you draw the working pairs on each step, you will see the shape resembling the layout of a brick wall.

In the first approach, let’s duplicate the code for each stage: odd and even.

sub odd-even-sort(@data) {
    my $done = False;
    while !$done {
        $done = True;
        loop (my $i = 0; $i < @data - 1; $i += 2) {
            if [>] @data[$i, $i + 1] {
                $done = False;
                @data[$i, $i + 1].=reverse;
            }
        }
        loop ($i = 1; $i < @data; $i += 2) {
            if [>] @data[$i, $i + 1] {
                $done = False;
                @data[$i, $i + 1].=reverse;
            }
        }
    }
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
odd-even-sort @data;
say @data;

There are two C-style loops here, both with the step 2.

It is possible to simply repeat the procedure @data.elems times, so you can remove the $done flag and use the postfix ifs.

sub odd-even-sort(@data) {
    for ^@data {
        loop (my $i = 0; $i < @data - 1; $i += 2) {
            @data[$i, $i + 1].=reverse if [>] @data[$i, $i + 1];
        }
        loop ($i = 1; $i < @data; $i += 2) {
            @data[$i, $i + 1].=reverse if [>] @data[$i, $i + 1];
        }
    }
}

Actually, if you want to use a flag, you can still do it with postfix if conditions:

sub odd-even-sort(@data) {
    my $done = False;
    while !$done {
        $done = True;
        loop (my $i = 0; $i < @data - 1; $i += 2) {
            $done--, @data[$i, $i + 1].=reverse 
                if [>] @data[$i, $i + 1];
        }
        loop ($i = 1; $i < @data; $i += 2) {
            $done--, @data[$i, $i + 1].=reverse
                if [>] @data[$i, $i + 1];
        }
    }
}

But that was the minor thing (although it is important for performance). For code beauty, we need to merge the loops, as they do the same work, just for different pairs of elements.

What if another loop with two iterations?

sub odd-even-sort(@data) {
    my $done = False;
    while !$done {
        $done = True;
        for 0..1 -> $start {
            loop (my $i = $start; $i < @data - 1 - $start; $i += 2) {
                $done--, @data[$i, $i + 1].=reverse 
                    if [>] @data[$i, $i + 1];
            }
        }
    }
}

Not bad, but what about sequences? Let us make a very verbose but quite understandable list of values that consists of two parts: even and odd indices:

sub odd-even-sort(@data) {
    my $done = False;
    while !$done {
        $done = True;
        for flat(
                (0, 2 ... @data - 2), (1, 3 ... @data - 1)
            ) -> $i {
            $done--, @data[$i, $i + 1].=reverse 
                if [>] @data[$i, $i + 1];
        }
    }
}

Of course, the for loop can go to the postfix part:

sub odd-even-sort(@data) {
    my $done = False;
    repeat {
        $done = True;
        $done--, @data[$_, $_ + 1].=reverse
            if [>] @data[$_, $_ + 1]
            for flat((0, 2 ... @data - 2), (1, 3 ... @data - 1));
    } until $done;
}

Or, if you don’t like using a flag:

sub odd-even-sort(@data) {
    while ![<=] @data {
        @data[$_, $_ + 1].=reverse if [>] @data[$_, $_ + 1]
            for flat((0, 2 ... @data - 2), (1, 3 ... @data - 1));
    }
}

(An extra comparison step can significantly slow the algorithm down.)

At this point, the code is quite compact, and if you’d like to work on it further, you have to express the sequence of odd and event numbers with less characters of code.

I wish you success! If you succeed, please share the solution with us. The source codes of all versions are available on GitHub.

💡 106. Gnome sort in Perl 6

Our today’s topic is the Gnome sort, which is also referred to as Stupid sort. To sort an array using this method, you scan the data from left to right and check the two adjacent items to see if they are ordered properly. If they are, you go forward. If not, you swap the elements and make a step back.

Here is the first implementation based on the above description:

sub gnome-sort(@data) {
    my $pos = 0;

    while $pos != @data.elems - 1 {
        if !$pos or @data[$pos] >= @data[$pos - 1] {
            $pos++;
        }
        else {
            @data[$pos, $pos - 1] .= reverse;
            $pos--;
        }
    }
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
gnome-sort @data;
say @data;

If you would follow the $pos value, you could see the long path that the gnome walked along the data to sort it:

0, 1, 2, 3, 2, 1, 0, 1, 2, 3, 4, 5, 6, 5, 4, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 3, 4, 5, 6, 7, 8, 7, 6, 5, 4, 3, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 8, 7, 8, 9, 10, 9, 8, 9, 10

The path above looks like some sequence, and it can be a good idea to use the Seq class available in Perl 6. Let me remind that you can generate sequences with the ... operator equipped with your own block of code to compute the next value. The interesting things is that you can also call an external function from that generator code block.

I am moving the main logic to a sub-function and here’s the code:

sub gnome-sort(@data) {

    sub f($i) {
        return 1 unless $i;

        if @data[$i] >= @data[$i - 1] {
            return $i + 1;
        }
        else {
            @data[$i, $i - 1] .= reverse;
            return $i - 1;
        }
    }

    for 1, -> $i {f($i)} ... @data.elems {
        
    }
}

As you see, the sequence is only needed to generate, erm, the sequence. The body of the loop is empty, as all the job is done within f.

Now, we can clean the code a bit and remove the unnecessary punctuation:

sub gnome-sort(@data) {

    sub f($i) {
        return 1 unless $i;
        return $i + 1 if [>=] @data[$i, $i - 1];
        
        @data[$i, $i - 1] .= reverse;
        return $i - 1;
    }

    1, -> $i {f($i)} ... @data.elems;
}

You may notice that the for loop is also gone, and the sequence is left alone. This is probably not a good practice as Perl could potentially optimise it and generate a lazy sequence instead. But it works as of today.

What you also can do is to split the function into three multi-functions, and make the whole code look very functional-programming-oriented.

sub gnome-sort(@data) {

    multi sub f(0) { 1 }

    multi sub f($i where [>=] @data[$i, $i - 1]) { $i + 1 }

    multi sub f($i) {
        @data[$i, $i - 1] .= reverse;
        return $i - 1;
    }

    1, -> $i {f($i)} ... @data.elems;
}

An update based on the comments left by a reader on Reddit. It is possible to further simplify the sequence by passing f as a callable object:

sub gnome-sort(@data) {

    proto sub f($) { * } 

    . . . # all multi-subs here

    1, &f ... @data.elems;
}

Nevertheless, it’s all for today. Check the code on GitHub and suggest any changes if you think they may be interesting for the readers.

💡 105. Pancake sort in Perl 6

The Pancake sort is an interesting method of sorting data, as unlike more traditional sorting algorithms, it operates with piles of data on each step.

You have to imagine data as a pile of pancakes, the values corresponding to the size of pancakes. The only allowed operation is flipping a pile of ‘pancakes.’ It can be any number of them, but they can be only the ones on the top of the whole pile.

You start from bottom and go one step up on each iteration. In the upper part of the pile, you search for the biggest pancake, and flip the pile from that position (thus, rotate the whole upper part including the just found maximum value). Then you rotate the top pile from the top to and including the pancake corresponding to the current step counter. Repeat until ready.

While it may sound weird, the algorithm really works. Let us implement it using approaches available in a generic programming language.

sub pancake-sort(@data) {
    my $n = @data.elems - 1;

    while $n > 1 {
        my $m = $n;
        my $max_n = $m;
        my $max = @data[$m];
        while --$m {
            if @data[$m] > $max {
                $max = @data[$m];
                $max_n = $m;
            }
        }

        @data[0..$max_n] .= reverse;
        @data[0..$n] .= reverse;
        
        $n--;
    }
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
pancake-sort @data;
say @data;

The two flips are clearly seen: those are the two .=reverse calls.

A big part of code is about searching for the maximum value on the current iteration. In Perl 6, there is the max routine, but we cannot directly use it as we need to find the position of the maximum element, not the element itself.

Perl 6 has a answer for that task too! It is the maxpairs method, which returns a sequence (an object of the Seq class) containing the pairs for all maximum elements: the key of a pair is the index of the element.

An updated version of the code is much shorter. It immediately uses the result of maxpairs in place of the $max_n value.

sub pancake-sort(@data) {
    my $n = @data.elems - 1;

    while $n > 1 {
        @data[0 .. @data[0..$n].maxpairs[*-1].key] .= reverse;
        @data[0..$n] .= reverse;
        
        $n--;
    }
}

Another possibility for making the code even more beautiful is to get rid of explicit counters in the while loop. As the counter goes down, ranges will not help: 10..1 produces Nil. But sequences can do that: 10...1 contains ten numbers. Let’s embed it to the sorting function:

sub pancake-sort(@data) {
    {
        @data[0 .. @data[0..$_].maxpairs[*-1].key] .= reverse;
        @data[0 .. $_] .= reverse;
    } for @data.elems - 1 ... 1;
}

This is where you can stop: the code is simple, clean and transparent. Or even yummy! Take a pancake on GitHub and add your flavour!

💡 104. Stooge sort in Perl 6

Have you ever heard of the Stooge sort algorithm? If not, it is quite interesting to learn it. The idea is clear, while you maybe need some time to see if it really works.

So, take a list of numbers and swap the first and the last elements if they are not sorted properly (that is, if the first element is bigger than the last one).

Then take the first two thirds of the data array and apply the procedure to those elements. When you are back, apply the procedure to the the right two thirds of it (thus, the two thirds but tied to the right edge). And after that, ‘confirm’ the result by stooge-sorting the first two thirds.

Repeat until everything is sorted.

This time, having some experience implementing the previous sorting algorithms, the final code is ready after the first iteration.

sub stooge-sort(@data) {
    return if [<=] @data;

    @data[0, *-1].=reverse if [>] @data[0, *-1];
    
    my $l = @data[0 ..^ Int(2/3 * ^@data)];
    my $r = @data[Int(1/3 * ^@data) .. *-1];
    
    stooge-sort($l);
    stooge-sort($r);
    stooge-sort($l);
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
stooge-sort @data;
say @data;

There are a few places where you can improve it a bit. The main being the check [<=] at the function entrance, which slows the whole algorithms down. One of the ideas to stop the iteration is to check if you are at the top level of recursion.

Although, I would like you to take a closer look at the fact that the function sorts data in-place, and you don’t have to pass array boundaries as function parameters.

The $l and $r variables keep the lists which refer to array slices. They are passed to another iteration level of stooge-sort, and the function changes original data. This is quite useful technique when you can pass a reference to a part of the array and modify it independently.

You can find the source file of today’s post on GitHub, feel free to share your thoughts and ideas! See you tomorrow!

💡 103. Merge sort in Perl 6

Welcome to another sorting episode, this time we’ll talk about Merge sort in Perl 6.

In Merge sort, you first split the data into halves until the pieces become atomic (in the original meaning of the word), that is either each piece contains a single element, or, after the current split, the second part contains no elements.

The second step is two merge pairs of pieces. If the pieces are trivial, you simply attach one element to another in the correct order and get a one- or two-item sublist. As the fragments grow, you have to take the two pieces and create a new list by taking the values from the beginning of each piece so that the final sequence is sorted (numeric or lexicographic, but we only talk about numbers so far).

The first ad-hoc implementation is shown below.

sub merge-sort(@data) {
    return @data if @data.elems <= 1;

    sub merge(@l, @r) {
        my @a;

        while (@l and @r) {
            my $v;
            if @l[0] < @r[0] {
                $v = @l.shift;
            }
            else {
                $v = @r.shift;
            }
            @a.push($v);
        }
        @a.push(|@l, |@r);
        
        return @a;
    }

    my $mid = @data.elems div 2;
    my @l = @data[^$mid];
    my @r = @data[$mid .. *-1];

    @l = merge-sort(@l);
    @r = merge-sort(@r);

    my @a = merge(@l, @r);

    return @a;
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
@data = merge-sort @data;
say @data;

Notice that the data is not sorted in-place. Also notice that the merge procedure is contained in a separate internal function.

The algorithm calls itself iteratively: for each @l and @r parts another round of merge-sort is initiated before the parts are merged via merge(@l, @r).

Let us beautify the code as far as it is possible. First, let’s get rid of a separate storage for the halves and move them straight to the function call:

my @l = merge-sort(@data[^$mid]);
my @r = merge-sort(@data[$mid .. *-1]);

The body of the merge function contains a lot of one-line fragments of code, which can be efficiently re-written using a ternary operator.

while (@l and @r) {
    my $v = @l[0] < @r[0] ?? @l.shift !! @r.shift;
    @a.push($v);
}

Now, the merge function seems to be redundant, and its actions can be moved to the place where the function is called. At this step, we can also gain some space from inlining temporary assignments and using postfix structures.

sub merge-sort(@data) {
    return @data if @data.elems <= 1;

    my $mid = @data.elems div 2;

    my @l = merge-sort(@data[^$mid]);
    my @r = merge-sort(@data[$mid .. *-1]);

    my @a;
    @a.push(@l[0] < @r[0] ?? @l.shift !! @r.shift)
        while @l and @r;
    @a.push(|@l, |@r);

    return @a;
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
@data = merge-sort @data;
say @data;

Maybe it is worth give comments about the two pushes. This code gets two arrays, which are already sorted (as they are the result of the merge-sort call). Each time, you look at the first elements in them, and pick the one which is smaller.

The first push adds elements to the result while both @l and @r parts contain elements. After at least one of them is exhausted, the second push adds the remaining element to the result. The remaining item is always not less than the last taken, as the arrays were already sorted.

While the call stack has been collapsing, the array gets sorted.

The final touch can be done to remove the temporary @a variable (and—how sad it can be to invent the wheel—make the code look alike its Rosettacode’s counter partner). In Perl 6, there is a pair of routines: take and gather, that collect data while you generate it, and then return the whole at once. Here is the modified version of the function:

sub merge-sort(@data) {
    return @data if @data.elems <= 1;

    my $mid = @data.elems div 2;

    my @l = merge-sort(@data[^$mid]);
    my @r = merge-sort(@data[$mid .. *-1]);

    return flat(gather {
        take(@l[0] < @r[0] ?? @l.shift !! @r.shift) while @l and @r;
        take(@l, @r);
    });
}

Also notice that flat before return allows you not to flatten the data in the second take.

You are welcome to further play with the code, which is available on GitHub, and merge interesting solutions into it.

💡 102. Insertion sort in Perl 6

Today, we are investigating the Insertion sort algorithm and its possible implementation in Perl 6. The algorithm’s complexity is O(n2), but it is a good candidate to practice some Perl 6.

The idea is simple. You find the minimum value in the array and put it to the first position. Then you scan the data starting from the second position (as the first position is already occupied with the lowest element). And you go on to the right, finding minimums and placing them to the current position until you reach the end.

It is similar to Selection sort, but instead of swapping the two elements, you insert one (and thus, shift the others). Let us start with the straightforward approach and two nested loops:

sub insertion-sort(@data) {
    for ^@data -> $i {
        for ^$i -> $j {
            if @data[$i] < @data[$j] {
                @data.splice($j, 0, @data[$i]);
                @data.splice($i + 1, 1);
            }
        }
    }
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
insertion-sort @data;
say @data;

In Perl 6, the splice method of arrays can serve two tasks: replace the part of the array with another list of elements or simply remove the element or a few elements in a row.

In the above code, both applications of the method are used. First, the new found element is inserted to the current position. Second, it is removed from its previous place (the array just grew, so the index became $i + 1).

As the splice method also returns the removed element(s), we can put the second call to the place where the element is being read: @data[$i]. And thus the two lines can be replaced with the following nested calls:

@data.splice($j, 0, @data.splice($i, 1))

Notice that the index is simply $i now as the array is not yet modified.

You should be already familiar with the second possible trick: let’s use the postfix if:

sub insertion-sort(@data) {
    for ^@data -> $i {
        for ^$i -> $j {
            @data.splice($j, 0, @data.splice($i, 1)) 
                if @data[$i] < @data[$j];
        }
    }
}

You can stop at this point, but I hope you are not yet satisfied. At least, the two nested fors seem to be a good field for further thinking.

Unfortunately, it is not possible to directly use a cross operator to have something like for ^@data X ^@data, as the second list depends on the first one, but there is a completely different way to simplify the code.

The primary goal of the most inner for loop is to find the first minimum element in the array. Perl 6 gives us the first method, which does exactly that.

By default, it returns the element, but we need its index. You do that by adding the :k named parameter:

@data.first(* >= @data[$_], :k)

A bare :k is equivalent to setting the parameter to True: :k(True) or k => True.

sub insertion-sort(@data) {
    for ^@data -> $i {
        @data.splice(
            @data.first(* >= @data[$i], :k), 
            0,
            @data.splice($i, 1)
        )
    }
}

Finally, make the only remaining for loop a postfix clause, and you are done with a nice one-line function (shown here split into shorter parts on different lines):

sub insertion-sort(@data) {
    @data.splice(
        @data.first(* >= @data[$_], :k), 
        0,
        @data.splice($_, 1)
    ) for ^@data;
}

my @data = 4, 5, 7, 1, 46, 78, 2, 2, 1, 9, 10;
insertion-sort @data;
say @data;

That’s all for now, but if you find something that can be improved, please let us know in the comments below. The source codes are available on GitHub.