Perl Weekly Challenge: Week 63

Unfortunately I've had to put the weekly challenge aside for the past two months—the longest hiatus I've taken since it began—but I'm back and I'll be dealing with the backlog in the next couple of weeks if all goes well.

Challenge 1:

Last Word

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'

This is the Perl solution:

sub last_word {
    my ($string, $regexp) = @_;
    if (ref($regexp) ne 'Regexp') {
        die "Not a regexp!";
    }

First I try and validate that the second argument is a regular expression. This was not required by the spec but it seems to be a prudent idea. Unexpectedly I ran into segfaults when I wrote ref $regexp. They went away when I added the parentheses. If my first attempt was a syntax error so be it but the result shouldn't be a crash. I will try to investigate if this is just me or if there is a bug in perl here.

    my $result = undef;

    for my $word (reverse split /\s+/, $string) {

I split the string into words and because we want the last matching word, reversed the collection of words so we can go through them starting from the end rather than the beginning.

        if ($word =~ $regexp) {
            $result = $word;
            last;
        }

Once we have the word, there is no need to continue so we break out of the loop and... }

    return $result;
}

...return $result. If we made it all the way through the list of words without a match, $result will remain undef.

(Full code on Github.)

In Raku, the function is a one liner. Proper function prototypes removes the need for validation code. The .first method saves having to have a loop-and-last like Perl needed.

sub last_word(Str $string, Regex $regexp) {
    return $string.split(/\s+/).reverse.first($regexp) // Nil;
}

(Full code on Github.)

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

Examples

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

Here is the Perl version:

sub rotations {
    my ($original) = @_;
    my $word = $original;
    my $word_length = length $original;
    my $rotation = 0;

    do {
        $rotation++;
        $word .= substr $word, 0, $rotation % $word_length, q{};

I used substr() to remove the rotated part from the beginning of the string and then concatenate it back to the end.

    } until ($word eq $original);

    return $rotation;
}

(Full code on Github.)

Raku is more interesting.

sub rotations(Str $original) {
    my $word = $original;
    my $word_length = $original.chars;
    my $rotation = 0;

    repeat {
        $rotation++;
        $word ~~ s/ ^ ( . ** { $rotation % $word_length} ) (.+)/$1$0/;

Raku lists have a .rotor method which would considerably simplify things but it is not available for strings. I suppose I could have split the string into an array, rotated it and joined it back again but that would have been very inefficient. So instead I tried the substr() approach I used with Perl. Unfortunately the Raku version of substr() doesn't seem to have the replacement feature. So instead I opted for a regex substitution. Which I could have used in Perl too if I had thought of it.

    } until ($word eq $original);

    return $rotation;
}

(Full code on Github.)