laurent_r

These are some answers to the Week 280, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on August 4, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Count Asterisks

You are given a string, $str, where every two consecutive vertical bars are grouped into a pair.

Write a script to return the number of asterisks, *, excluding any between each pair of vertical bars.

Example 1

Input: $str = "p|*e*rl|w**e|*ekly|"
Ouput: 2

The characters we are looking here are "p" and "w**e".

Example 2

Input: $str = "perl"
Ouput: 0

Example 3

Input: $str = "th|ewe|e**|k|l***ych|alleng|e"
Ouput: 5

The characters we are looking here are "th", "e**", "l***ych" and "e".

We'll use a regex substitution to remove the parts of the input strings to be excluded from the count (parts between pairs of vertical bars or pipe characters). There are many ways of counting the asterisks in the remaining parts of the input string, including various types of loops, but, it is simpler to use the tr/// transliteration operator, which returns essentially the number of changes performed. And, at least in Perl, the transliteration operator is reputed to be the fastest way of counting the occurrences of a character in a string.

Count Asterisks in Raku

For our substitution, we need our regex to match a vertical bar, followed by any number of characters other than the pipe, followed by a pipe. This is easily achieved with a frugal (or non-greedy) quantifier, which will match as much as it has to for the overall regex to succeed, but not more than that. This leads to the following possible regex: s:g/'|'.*?'|'//. The *? part is the frugal quantifier.

As mentioned above, we can use the tr/// transliteration operator to count the asterisks. In Raku, the transliteration operator returns not exactly the number of changes performed as informally stated above, but more precisely a StrDistance object, which will numify to the distance (or number of edits) between the original and resulting strings. Numification is performed here with a + sign before the overall expression.

This leads to the following program:

sub count-asterisks ($in is copy) {
    $in ~~ s:g/'|'.*?'|'//;
    return +($in ~~ tr/*//);
}

my @tests = "p|*e*rl|w**e|*ekly|", "perl", 
            "th|ewe|e**|k|l***ych|alleng|e";
for @tests -> $test {
    printf "%-30s => ", $test;
    say count-asterisks $test;
}

This program displays the following output:

$ raku ./count-asterisks.raku
p|*e*rl|w**e|*ekly|            => 2
perl                           => 0
th|ewe|e**|k|l***ych|alleng|e  => 5

Count Asterisks in Perl

This is a port to Perl of the above Raku program. The regex syntax is slightly different, but it uses a similar frugal quantifier and leads to the same matches.

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

sub count_asterisks {
    my $in = shift;
    $in =~ s/\|.*?\|//g;
    return +($in =~ tr/*//);
}

my @tests = ("p|*e*rl|w**e|*ekly|", "perl", 
          "th|ewe|e**|k|l***ych|alleng|e");
for my $test (@tests) {
    printf "%-30s => ", $test;
    say count_asterisks $test;
}

This program displays the following output:

$ perl ./count-asterisks.pl
p|*e*rl|w**e|*ekly|            => 2
perl                           => 0
th|ewe|e**|k|l***ych|alleng|e  => 5

Wrapping up

The next week Perl Weekly Challenge will 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 August 11, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.