💡 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.

💡 101. Quick sort in Perl 6

Today, let’s look at another, and presumably the most well known method of sorting data, Quick sort.

The algorithm requires you to select the so-called pivot, one of the element from the data, and split the rest in two parts: the elements less than the pivot, and the elements more or equals to the pivot. Each part is then recursively sorted again. On each iteration, the parts become smaller and smaller until the sublists are trivial data sets of one or even zero elements.

A separate theory is how to choose the right pivot. There are a few methods, for example, taking a value from the middle of the list, or taking the first item, or the last, or a random item. There are also more complicated methods, and you can tune it to achieve the best performance on your type of data sets.

For simplicity, let’s choose the first element as a pivot, and here is the code:

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

    my $pivot = @data[0];

    my @left;
    my @right;

    for @data[1..*] -> $x {
        if $x < $pivot {
            push @left, $x;
        }
        else {
            push @right, $x;
        }
    }

    return flat(quick-sort(@left), $pivot, quick-sort(@right));
}

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

Unlike the previous examples of Bubble sort, this program does not sort in-place but returns a new list instead.

Now it is time to transform the code to make it more Perl 6-ish.

Multi-subs come for the rescue again, which while increasing the number of lines of code, make the whole algorithm easier to catch at a first glance.

multi sub quick-sort(@data where @data.elems <= 1) {
    return @data;
}

multi sub quick-sort(@data where @data.elems > 1) {
    my $pivot = @data[0];

    . . .
}

Now, take a look at these two pieces:

my $pivot = @data[0];

. . .

for @data[1..*] -> $x {

The first element needs to be taken, and the rest of the algorithm only deals with the rest of the list. Currently, this is achieved by taking an element and a slice, but there’s a shift method that does exactly what we need, and removes the element from the data. So, let’s use it:

my $pivot = @data.shift;

. . .

for @data -> $x {

The next comes the ifelse selection, which can be effectively (although maybe a bit less efficiently) be replaced with the two greps: one selecting the part prior to the pivot, another selecting the rest.

my @left = @data.grep(* < $pivot);
my @right = @data.grep(* >= $pivot);

Basically, that’s it. What you can also do is to get rid of temporary variables and put the filters to the return statement:

return flat(
    quick-sort(@data.grep(* < $pivot)),
    $pivot,
    quick-sort(@data.grep(* >= $pivot))
);

It all worked before this last change, but now it is broken:

$ perl6 quick-sort.pl 
Cannot call 'pop' on an immutable 'List'
   in sub quick-sort at 3.pl line 6
   in sub quick-sort at 3.pl line 8
   in block <unit> at 3.pl line 12

The problem is that you need to return a single list of numbers, but each subcall of quick-sort returns its own lists.

You can easily address the issue by slurping the elements by putting a * before the function argument:

multi sub quick-sort(*@data where @data.elems > 1) {
    . . .

The final code looks like this:

multi sub quick-sort(*@data where @data.elems <= 1) {
    return @data;
}

multi sub quick-sort(*@data where @data.elems > 1) {
    my $pivot = @data.shift;

    return flat(
        quick-sort(@data.grep(* < $pivot)),
        $pivot,
        quick-sort(@data.grep(* >= $pivot))
    );
}

Instead of using the flat routine, you can also flat each list independently using the |:

return
    |quick-sort(@data.grep(* < $pivot)),
    $pivot,
    |quick-sort(@data.grep(* >= $pivot));

But I think it is still better to have a couple of understandable intermediate variables to avoid punctuation noise:

multi sub quick-sort(@data where @data.elems <= 1) {
    return @data;
}

multi sub quick-sort(@data where @data.elems > 1) {
    my $pivot = @data.shift;

    my @left = @data.grep(* < $pivot);
    my @right = @data.grep(* >= $pivot);

    return flat(quick-sort(@left), $pivot, quick-sort(@right));
}

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

As a home work, create an implementation of the Quick sort algorithm that sorts the data in-place.

The code is available on GitHub, you are welcome to join this journey too!

And let me update the post with based on some comments on Reddit.

First, instead of two greps, it was nice to use some function that does the separation in one go (as it was in the original program with if and else). Actually, Perl 6 has one. It is called classify, and it returns a hash, where the keys are all the possible values of the condition. In our case, it will be True (when the element is less than the pivot), and False otherwise.

multi sub quick-sort(@data where @data.elems > 1) {
    my $pivot = @data.shift;

    my %part = @data.classify(* < $pivot);

    return flat(
        quick-sort(%part{True} // []), 
        $pivot,
        quick-sort(%part{False} // [])
    );
}

As it may happen that all elements are on the same side of the pivot, you need to make sure you pass an empty list in that case (thus, // []).

The second change will lead to the the code similar to what is published (as of today) on Rosettacode. Indeed, if our choice of the pivot is the first element, than it is possible to separate it in the function signature instead of manually taking the item in the code. You can also simplify the signature of the first multi-method:

multi sub quick-sort([]) {
    return [];
}

multi sub quick-sort([$pivot, *@data]) {
    my %part = @data.classify(* < $pivot);

    return flat(
        quick-sort(%part{True} // []),
        $pivot,
        quick-sort(%part{False} // [])
    );
}

Rosettacode’s code also does not have a return statement. You can do that too, while I prefer having an explicit return in the function.

Can you suggest any further clever change?