laurent_r

These are some answers to the Week 229, Task 1, 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 August 13, 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: Lexicographic Order

You are given an array of strings.

Write a script to delete element which is not lexicographically sorted (forwards or backwards) and return the count of deletions.

Example 1

Input: @str = ("abc", "bce", "cae")
Output: 1

In the given array "cae" is the only element which is not lexicographically sorted.

Example 2

Input: @str = ("yxz", "cba", "mon")
Output: 2

In the given array "yxz" and "mon" are not lexicographically sorted.

Lexicographic Order in Raku

In the unsorted subroutine, for each input string, the string is split into individual letters and then sorted in lexicographic order. We then compare the original string with the strings produced with the re-arranged letters in lexicographic order and reverse lexicographic order. Note that we use here an any Junction to avoid separate equality tests. Note that the sort function defaults to lexicographic sort when given letters.

sub unsorted (@in) {
    my $count = 0;
    for @in -> $str {
        my @let = $str.comb.sort;
        $count++ if $str ne 
            (@let.join(""), @let.reverse.join("")).any;
    }
    return $count;
}
for <abc bce cae>, <yxz cba mon> -> @test {
    printf "%-12s => ", "@test[]";
    say unsorted @test;
}

This program displays the following output:

$ raku ./lexicographic-order.raku
abc bce cae  => 1
yxz cba mon  => 2

Lexicographic Order in Perl

This is essentially a port to Perl of the above Raku program. Please refer to the above if you want further explanations. The only significant difference is that, since there are no Junctions in Perl, we use two separate inequality tests. Note that sort defaults to lexicographical sort when it is not given a special comparison subroutine.

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

sub unsorted {
    my $count = 0;
    for my $str (@_) {
        my @let = sort split //, $str;
        $count++ if $str ne join "", @let and 
        $str ne join "", reverse @let;
    }
    return $count;
}
for my $test ([<abc bce cae>], [<yxz cba mon>]) {
    # print $test;
    printf "%-12s => ", "@$test";
    say unsorted @$test;
}

This program displays the following output:

$ perl ./lexicographic.pl
abc bce cae  => 1
yxz cba mon  => 2

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