Perl Weekly Challenge: Week 331

Challenge 1:

Last Word

You are given a string.

Write a script to find the length of last word in the given string.

Example 1
Input: $str = "The Weekly Challenge"
Output: 9
Example 2
Input: $str = "   Hello   World    "
Output: 5
Example 3
Input: $str = "Let's begin the fun"
Output: 3

We can do this as a one-liner.

First we get the input from the first command-line argument and assign it to $_. Then we use a regular expression to find the last sequence of word characters optionally followed by non-word characters. (This bit is neccessary for e.g. example 2.) Then we measure the length of the word we found with ,chars() and print it or 0 in the event that no appropriate word was found.

$_ = @*ARGS[0]; /(\w+)\W*$/; say $0.chars || 0

(Full code on Github.)

The Perl version is just slightly shorter.

$_ = shift; /(\w+)\W*$/; say length $1 || 0

(Full code on Github.)

Challenge 2:

Buddy Strings

You are given two strings, source and target.

Write a script to find out if the given strings are Buddy Strings.

If swapping of a letter in one string make them same as the other then they are `Buddy Strings`.
Example 1
Input: $source = "fuck"
    $target = "fcuk"
Output: true

The swapping of 'u' with 'c' makes it buddy strings.
Example 2
Input: $source = "love"
    $target = "love"
Output: false
Example 3
Input: $source = "fodo"
    $target = "food"
Output: true
Example 4
Input: $source = "feed"
    $target = "feed"
Output: true

The MAIN() function is very simple; all it does is get the $source and $target strings from the input, pass them to the isBuddyString() function and print the result.

isBuddyString($source, $target).say;

isBuddyString() is where all the action is. It will return True or False depending on whether $source and `$target are buddy strings or not.

sub isBuddyString($source, $target) {

The first test it makes is to see if $source and $target are equal in length; if they are not, they are obviously not buddy strings and there is no point in proceeding further; we return False.

    if $source.chars != $target.chars {
        return False;
    }

This one is subtle. If the two strings are exactly the same and they contain more than one instance of the same letter, that letter can be swapped so the strings are buddy strings. Example 4 illustrates this.

    if ($source eq $target) {

We count the frequency of letters in $source (which, remember, is the same as $target in this scenario.) my %count;

        for $source.comb -> $c {
            %count{$c}++;
        }

if one or more letters appears more than once, we return True otherwise False. (.so() forces Boolean context.)

        return %count.values.grep({ $_ > 1 }).so;
    }

If the two strings are the same length but differ in contents we need to do some work. We need to find all positions where the characters differ.

    my $diff = 0;

    for 0 ..^ $source.chars -> $i {
        if $source.substr( $i, 1) ne $target.substr($i, 1) {
            $diff++;
        }
    }

If there are not exactly two such positions, it's impossible to make the strings equal with a single swap, so we return False.

    if ($diff != 2) {
        return False;
    }

If there are exactly two differing positions we have buddy strings so return True.

    return True;
}

(Full code on Github.)

The Perl version is a direct copy of Raku.

say isBuddyString($source, $target) ? "True" : "False";

sub isBuddyString($source, $target) {

    if (length($source) != length($target)) {
        return false;
    }

    if ($source eq $target) {
        my %count;

        for my $c (split //, $source) {
            $count{$c}++;
        }

        return grep { $_ > 1 } values %count ? true : false;
    }

    my $diff = 0;

    for my $i (0 .. length($source) - 1) {
        if (substr($source, $i, 1) ne substr($target, $i, 1)){
            $diff++;
        }
    }

    if ($diff != 2) {
        return false;
    }

    return true;
}

(Full code on Github.)