Perl Weekly Challenge: Week 365

Challenge 1:

Alphabet Index Digit Sum

You are given a string $str consisting of lowercase English letters, and an integer $k.

Write a script to convert a lowercase string into numbers using alphabet positions (a=1 … z=26), concatenate them to form an integer, then compute the sum of its digits repeatedly $k times, returning the final value.

Example 1
Input: $str = "abc", $k = 1
Output: 6

Conversion: a = 1, b = 2, c = 3 -> 123
Digit sum: 1 + 2 + 3 = 6
Example 2
Input: $str = "az", $k = 2
Output: 9

Conversion: a = 1, z = 26 -> 126
1st sum: 1 + 2 + 6 = 9
2nd sum: 9
Example 3
Input: $str = "cat", $k = 1
Output: 6

Conversion: c = 3, a = 1, t = 20 -> 3120
Digit sum: 3 + 1 + 2 + 0 = 6
Example 4
Input: $str = "dog", $k = 2
Output: 8

Conversion: d = 4, o = 15, g = 7 -> 4157
1st sum: 4 + 1 + 5 + 7 = 17
2nd sum: 1 + 7 = 8
Example 5
Input: $str = "perl", $k = 3
Output: 6

Conversion: p = 16, e = 5, r = 18, l = 12 -> 1651812
1st sum: 1 + 6 + 5 + 1 + 8 + 1 + 2 = 24
2nd sum: 2+4 = 6
3rd sum: 6

We can get the numeric value of a character with .ord(). In the ASCII arrangement of characters, the character before the lower vase letters is ` (backtick). If we subreact the value of this from the value of a lower-case letter, we get a number from 1 to 26 which is the position of the character in the alphabet. As we will be doing this a lot, we assign the value of ` to a variable.

my $base = q{`}.ord;

The initial numeric value of the input can be determined by splitting $str into individual characters, using .map() and .ord() to replace them with their corresponding alphabet position and then joining those up together again with .join().

my $result = $str.comb.map({ $_.ord - $base }).join;

We assign $k to another variable because we nned to decrement its' value and $k itself as a function parameter is immutable.

my $i = $k;

Now while $i is not equal to 0, we decrement it and split $result into digits, add them together with .sum() and assign this new value back to $result.

while $i-- {
    $result = $result.comb.sum;
}

After completing $k iterations of this, we have the final result which we can print.

say $result;

(Full code on Github.)

For Perl, we have to provide a replacement sum() but other than that, the Perl version is practically the same as Raku.

my $base = ord q{`};
my $result = join q{}, map {  ord($_) - $base } split //, $str;
my $i = $k;

while ($i--) {
    $result = sum(split //, $result);
}

say $result;

(Full code on Github.)

Challenge 2:

Valid Token Counterr

You are given a sentence.

Write a script to split the given sentence into space-separated tokens and count how many are valid words. A token is valid if it contains no digits, has at most one hyphen surrounded by lowercase letters, and at most one punctuation mark (!, ., ,) appearing only at the end.

Example 1
Input: $str = "cat and dog"
Output: 3

Tokens: "cat", "and", "dog"
Example 2
Input: $str = "a-b c! d,e"
Output: 2

Tokens: "a-b", "c!", "d,e"
"a-b" -> valid (one hyphen between letters)
"c!"  -> valid (punctuation at end)
"d,e" -> invalid (punctuation not at end)
Example 3
Input: $str = "hello-world! this is fun"
Output: 4

Tokens: "hello-world!", "this", "is", "fun"
All satisfy the rules.
Example 4
Input: $str = "ab- cd-ef gh- ij!"
Output: 2

Tokens: "ab-", "cd-ef", "gh-", "ij!"
"ab-"   -> invalid (hyphen not surrounded by letters)
"cd-ef" -> valid
"gh-"   -> invalid
"ij!"   -> valid
Example 5
Input: $str = "wow! a-b-c nice."
Output: 2

Tokens: "wow!", "a-b-c", "nice."
"wow!"  -> valid
"a-b-c" -> invalid (more than one hyphen)
"nice." -> valid

The MAIN() function is very simple. $str is .split() into tokens and we find the valid ones with .grep() and isValidToken(), then count how many we found with .elems() and print the result with .say().

$str.split(/\s+/).grep({ isValidToken($_) }).elems.say

The bulk of the work is done in isValidToken() which takes a token as its' only parameter and returns True or False if the token is valid or not.

sub isValidToken($token) {

First we check for digits. If there is a digit anywhere in the token, it is invalid and we can return False. For all the checks, I've assigned the regular expression for the thing we're checking to a variable. This makes the code more readable in my opinion.

    my $digit = rx/ \d /;
    if $token.match(/ $digit /) {
        return False;
    }

Next we check for hyphens.

    my $hyphen = rx/ \- /;

If there is a hyphen in the token...

    if $token.match(/ ($hyphen) /, :g) &&

$/ stores the number of matches found; There should only be one. If there is more than that, the token is invalid.

    ($/.elems != 1

Or if there is only one hyphen, if there isn't a lower-case letter on either side of it, the token is invalid.

                    || !$token.match(/ <lower> $hyphen <lower> /)) {

In both cases, an invalid token causes us to return False.

        return False;
    }

We do a similar thing for punctuation. If there is one of the special punctuation characters in the token, there should only be one and it should be at the end of the token. If these conditions are not met, we return False.

    my $punct = rx/<[\!\.\,]>/;
    if $token.match(/ ($punct) /, :g) &&
    ($/.elems != 1 || !$token.match(/$punct $/)) {
        return False;
    }

If all the checks pass, we have a valid token so we return True.

    return True;
}

(Full code on Github.)

And this is the Perl version. This time we did not to provide any additional code, Perl has everything we need.

say scalar grep { isValidToken($_) } split /\s+/, $str;

sub isValidToken($token) {

    my $digit = qr/\d/;
    if ($token =~ /$digit/) {
        return false;
    }

    my $hyphen = qr/-/;
    if ($token =~ /($hyphen)/g &&
    (scalar @{^CAPTURE} != 1 || $token !~ /[[:lower:]]$hyphen[[:lower:]]/)) {
        return false;
    }

    my $punct = qr/[!.,]/;
    if ($token =~ /($punct)/g && (scalar @{^CAPTURE} != 1 || $token !~ /$punct$/)) {
        return false;
    }

    return true;
}

(Full code on Github.)