laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days (June 7, 2020). 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: Last Word Matching a Regex

Define sub last_word($string, $regexp) that returns the last word matching $regexp found in the given string, or undef if the string does not contain a word matching $regexp.

For this challenge, a “word” is defined as any character sequence consisting of non-whitespace characters (\S) only. That means punctuation and other symbols are part of the word.

The $regexp is a regular expression. Take care that the regexp can only match individual words! See the Examples for one way this can break if you are not careful.

Examples:

last_word('  hello world',                qr/[ea]l/);      # 'hello'
last_word("Don't match too much, Chet!",  qr/ch.t/i);      # 'Chet!'
last_word("spaces in regexp won't match", qr/in re/);      #  undef
last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/); # '399933'

The only very slight difficulty here is that regular expressions or regexes fundamentally explore strings from left to right. It is possible to use the g modifier (in Perl) or :g adverb (in Raku) to get all the matches and then keep only the last one, but I’ve decided to use another approach which is simpler and also likely to be more efficient in most cases (when it matters): split the string into words, reverse the list and find the first match.

I’ve decided to return “Not found”, rather than undef for two reasons: first, undef does not exist in Raku and, besides, I think that printing “Not found” looks nicer.

Last Word Matching a Regex in Raku

Raku has a built-in words method that splits a string into words (the delimiter being white space) and a reverse method to reverse the items of a list. We only need to look at each item and stop when we get the first pattern match:

use v6;

sub last-word (Str $str, $regex) {
    for $str.words.reverse -> $reversed {
        return $reversed if $reversed ~~ $regex;
    }
    return "Not found";
}

say last-word "Hello Word", rx/<[ae]>l/;
say last-word("Don't match too much, Chet!",  rx:i/ch.t/);
say last-word("spaces in regexp won't match", rx:s/in re/);
my $str = join(' ', 1..1e5);
say last-word( $str, rx/^8 ** 3/);

This produces the following output:

$ perl6 last-word.p6
Hello
Chet!
Not found
88899

Last Word Matching a Regex in Perl

Besides small syntax differences, porting the Raku program to Perl only required replacing words with split on white space:

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

sub last_word {
    my ($str, $regex) = @_;
    for my $reversed (reverse split /\s+/, $str) {
        return $reversed if $reversed =~ $regex;
    }
    return "Not found";
}

say last_word('  hello world',                qr/[ea]l/); 
say last_word("Don't match too much, Chet!",  qr/ch.t/i);
say last_word("spaces in regexp won't match", qr/in re/);
say last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/);

This program displays the following output:

$ perl last-word.pl
hello
Chet!
Not found
399933

Task 2: Rotate String

Given a word made up of an arbitrary number of x and y characters, that word can be rotated as follows: For the ith rotation (starting at i = 1), i % length(word) characters are moved from the front of the string to the end. Thus, for the string xyxx, the initial (i = 1) % 4 = 1 character (x) is moved to the end, forming yxxx. On the second rotation, (i = 2) % 4 = 2 characters (yx) are moved to the end, forming xxyx, and so on. See below for a complete example.

Your task is to write a function that takes a string of xs and ys and returns the minimum non-zero number of rotations required to obtain the original string. You may show the individual rotations if you wish, but that is not required.

Example:

Input: $word = 'xyxx';

Rotation 1: you get yxxx by moving x to the end.
Rotation 2: you get xxyx by moving yx to the end.
Rotation 3: you get xxxy by moving xxy to the end.
Rotation 4: you get xxxy by moving nothing as 4 % length(xyxx) == 0.
Rotation 5: you get xxyx by moving x to the end.
Rotation 6: you get yxxx by moving xx to the end.
Rotation 7: you get xyxx by moving yxx to the end which is same as the given word.

Output: 7

Rotate String in Raku

For solving this task, I decided to write a rotate-once subroutine, taking a string and a number of characters to be shifted as arguments, to perform one individual rotation. That subroutine is only one code line, so the code could very well have been in-lined in the main loop, but the main reason for writing a separate subroutine is that it makes it possible to properly unit test it (it is just too easy to make an off-by-one error on such processing), even though I won’t show these simple tests which are not part of the task. The rotate-str subroutine simply implements an infinite loop to generate the successive rotated strings and breaks out of the loop with a return statement when the new rotated string is the same as original input string.

sub rotate-once (Str $str, Int $num) {
    $str.substr($num, $str.chars - $num) ~ $str.substr(0, $num);
}
sub rotate-str (Str $origin-str) {
    my $tmp = $origin-str;
    my $len = $origin-str.chars;
    my $i = 1;
    loop {
        $tmp = rotate-once $tmp, $i % $len;
        # say $tmp;
        return $i if $tmp eq $origin-str;
        $i++;
    }
}
for <xyxx xxyyy abcdefgh> {
    say "Got original string $_ after {rotate-str($_)} rotations.";
}

Simply uncomment the say statement in the loop to display the individual rotations (that’s quite useful to check the results).

The loop control-flow statement normally takes three statements in parentheses to implement the equivalent of a C-style for statement:

loop (my $i = 0; $i < 10; $i++) {
    say $i;
}

Using loop { ... } with no such three statements (and no parentheses) is just an idiomatic way to implement an infinite loop in Raku, just like while (1) { ... } in Perl.

The above program displays the following output:

$ perl6 rotate_str.p6
Got original string xyxx after 7 rotations.
Got original string xxyyy after 4 rotations.
Got original string abcdefgh after 15 rotations.

Note that I have duly noticed that the original task description said that the input string should be made of letters x and y. One of my test examples above uses other letters because it makes it a bit easier to check the results.

Rotate Strings in Perl

The following program is simply a port to Perl of the Raku program above:

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

sub rotate_once {
    my ($str, $num) = @_;
    substr($str, $num, length($str) - $num) . substr($str, 0, $num);
}
sub rotate_str {
    my $origin_str = shift; 
    my $tmp = $origin_str;
    my $len = length $origin_str;
    my $i = 1;
    while (1) {
        $tmp = rotate_once $tmp, $i % $len;
        return $i if $tmp eq $origin_str;
        $i++;
    }
}
for (qw<xyxx xxyyy abcdefgh>) {
    say "Got original string $_ after ", rotate_str($_), " rotations.";
}

This program displays the same output as the Raku program above:

$ perl rotate_str.pl
Got original string xyxx after 7 rotations.
Got original string xxyyy after 4 rotations.
Got original string abcdefgh after 15 rotations.

Wrapping up

The next week Perl Weekly Challenge is due to 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 Sunday, June 14, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.