laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on April 23, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Fun Sort

You are given a list of positive integers.

Write a script to sort the all even integers first then all odds in ascending order.

Example 1

Input: @list = (1,2,3,4,5,6)
Output: (2,4,6,1,3,5)

Example 2

Input: @list = (1,2)
Output: (2,1)

Example 3

Input: @list = (1)
Output: (1)

Fun Sort in Raku

In theory, this task should ideally use a special comparison subroutine to be used with sort that leads to the desired sorting order.

It is, however, simpler to separate even and odd numbers into two lists (for example using grep), sort the lists and then reassemble the lists in the proper order.

sub fun-sort (@in) {
    return (@in.grep({$_ %% 2}).sort, 
            @in.grep({$_ % 2}).sort).flat;
}

for <1 2 3 4 5 6>, <1 2>, (1,),
     1..15, (1..15).reverse -> @test {
    say fun-sort @test;
}

This program displays the following output:

$ raku ./fun-sort.raku
(2 4 6 1 3 5)
(2 1)
(1)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)

For the fun of it, or perhaps for the sake of trying to be pedantic ;-) , let’s see how we can do the same using a special comparison subroutine. Note that Less and More (and also Same) are special values provided by the Order enum and are respectively equal to -1 and 1 (and 0). When the fun-cmp subroutine returns Less (i.e. -1), then the sort routine knows that the first parameter ($a in this case) should be ordered before the second one ($b). Conversely, the first parameter should be ordered after the second one if the comparison subroutine returns More. When both parameters are even, or both are odd, we just use the <=> numeric comparison operator (which also returns Less, More, or Same to the sort function).

sub fun-cmp ($a, $b) { 
    if $a %% 2 {
        return $a <=> $b if $b %% 2;
        return Less;
    } else {
        return $a <=> $b unless $b %% 2;
        return More;
  }
}

for <1 2 3 4 5 6>, <1 2>, (1,),
     1..15, (1..15).reverse -> @test {
    say sort &fun-cmp, @test;
}

This program displays the following output:

$ raku ./fun-sort2.raku
(2 4 6 1 3 5)
(2 1)
(1)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)

Fun Sort in Perl

This is a port to Perl of the first Raku program above, splitting the input into two lists (even and odd numbers), sorting them separately and reassembling the sorted sub-lists at the end.

use strict;
use warnings;
use feature 'say';

sub fun_sort {
    return (sort { $a <=> $b } grep { $_ % 2 == 0 } @_),
           (sort { $a <=> $b } grep { $_ % 2 != 0 } @_);
}

for my $test ([<1 2 3 4 5 6>], [(1, 2)], [(1)],
    [1..15], [reverse (1..15)]) {
    say join " ", fun_sort @$test;
}

This program displays the following output:

$ perl ./fun-sort.pl
2 4 6 1 3 5
2 1
1
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15

Note that we could also first sort the input and then split the result into even and odd numbers and finally rearrange them:

use strict;
use warnings;
use feature 'say';

sub fun_sort {
    my @sorted = sort { $a <=> $b } @_;
    return (grep { $_ % 2 == 0 } @sorted), 
           (grep { $_ % 2 != 0 } @sorted);
}

for my $test ([<1 2 3 4 5 6>], [(1, 2)], [(1)],
    [1..15], [reverse (1..15)]) {
    say join " ", fun_sort @$test;
}

This program displays the same output as before:

2 4 6 1 3 5
2 1
1
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15

Finally, just as in Raku, we can also be pedantic in Perl and write a special comparison subroutine:

use strict;
use warnings;
use feature 'say';

sub fun_cmp { 
    if ($a % 2 == 0) {
        return $a <=> $b unless $b % 2;
        return -1;
    } else {
        return $a <=> $b if $b % 2;
        return 1;
  }
}

for my $test ([<1 2 3 4 5 6>], [(1, 2)], [(1)],
    [1..15], [reverse (1..15)]) {
    say join " ", sort { fun_cmp } @$test;
}

This program displays again the same output:

2 4 6 1 3 5
2 1
1
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15

Task 2: Shortest Route

This second task will be handled later, if I find the time.

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 April 30, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.