PWC 331, 332 Odd last date letters, binary word list buddy

This content originally appeared on DEV Community and was authored by Bob Lied

It’s been a while for Perl Weekly Challenge posts. The last few have been pretty easy, so let’s do a quick set of observations.

PWC 332 Task 2 Odd Letters

You are given a string. Write a script to find
out if each letter in the given string appeared
an odd number of times.

Counting occurrences has come up often, and we know how to do it using a hash. After splitting the string into individual letters, we need to check that all the counts are odd. This is an opportunity to use the new built-in all that was added in Perl 5.42.

use v5.42;
use feature 'keyword_all';
no warnings 'experimental::keyword_all';

sub oddLetter($str)
{
    my %letter;
    $letter{$_}++ for split(//, $str);
    return all { $_ % 2 } values %letter;
}

Notes:

• The built-in all is still experimental, so it’s a bit verbose to use. List::Util::all is still out there.
• split(//, $str) — standard idiom for converting a string into a list of characters.
• values %letter — It’s nice that Perl has a way to get a list of the values in the hash, because the keys aren’t important in this context.

PWC 332 Task 1 Binary Date

You are given a date in the format YYYY-MM-DD.
Write a script to convert it into binary date.

• Example
  • Input: $date = “2025-07-26”
  • Output: “11111101001-111-11010”

The trick is be the sort of person who reads books and manual pages and knows that sprintf has a format specifier for binary numbers. Assuming a valid format, the date comes apart by using a dash as a separator.

sub binaryDate($date)
{
    return sprintf("%b-%b-%b", split(/-/, $date));
}

PWC 331 Task 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`.

• Examples
  • “fuck”, “fcuk” are buddy strings (swap c and u)
  • “love”, “love” are not (any swap makes them unequal)
  • “feed”, “feed” are buddies (swap the two e‘s)

The examples coincidentally have the swaps next to each other, but I’m going to infer that they could be far apart in the string. That means we’ll have to consider every possible pair.

We can also quickly eliminate any pair that don’t have the same length.

sub isBuddy($source, $target)
{
    return false if length($source) != length($target);

    my @s = split(//, $source);
    my @t = split(//, $target);

    for my $i ( 0 .. $#s - 1 )
    {
        for my $j ( $i+1 .. $#s )
        {
            if ( $s[$i] eq $t[$j] && $s[$j] eq $t[$i] )
            {
                # We have a swappable pair. Do the rest of the
                # strings match?
                my @src = @s;
                ( $src[$i], $src[$j] ) = ( $t[$i], $t[$j] );
                return true if "@src" eq "@t";
            }
        }
    }
    return false;
}

Notes:

• We’ll turn both strings into arrays, to make it convenient to loop over the characters, and for easy indexing. We could keep them as strings and process characters using substr, but that gets quite cluttered.
• The double for loop is a frequent flyer for finding pairs. Note that the outer loop stops before the end of the array, and the inner loop starts where the outer loop left off.
• Once we have a pair that could swap, we still need to check that the rest of the string is the same. Many choices here. I’m doing it by copying the source string and doing the swap in the copy. Then, I’m using string interpolation for both "@src" and "@t", which is a slightly obfuscated way to do an array compare.

• The compare could be optimized. Interpolating @t every time could be factored out, or we could join @src with an empty string, so that it could be string-compared to $target.

• For calling the function using command line arguments, we can use a feature added to Perl a while back that lets for loops process pairs of elements at a time:
  

for my ($src, $targ) ( @ARGV )
{
    say (isBuddy($src, $targ) ? "true" : "false");
}

PWC 331 Task 1 Last Word

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

Splitting a string on white space is a trivial Perl idiom. But we do cross into the question of whether these are really words in text, because then we have to deal with punctuation and contractions.

Since the problem doesn’t give us any guidance, I’m going to do the minimal by taking the last field of the string and stripping any surrounding punctuation. That will take care of quotes and end punctuation, but contractions will remain intact and include the apostrophe.

• “She said, ‘(What!)'” will reduce to “What”
• “I wouldn’t!” will report that the last word (“wouldn’t”) has 8 letters.

sub lastWord($str)
{
    my $last = (split(/ /, $str))[-1] // "";
    $last =~ s/[[:punct:]]+$//;
    $last =~ s/^[[:punct:]]+//;
    return length($last);
}

Notes:

• (split(...))[-1] will treat the result of split as an array and then take its last element, without having to introduce a temporary array variable
• ... // "" — handles the possibility of an empty input, which would otherwise create a warning about an uninitialized variable
• [[:punct:]] is a nice shorthand for all possible Unicode punctuation in whatever language the string might be in. I’m naively going to assume that’s appropriate for all the languages that I’m clueless about.

This content originally appeared on DEV Community and was authored by Bob Lied