June 2024 Archives

# Perl Weekly Challenge 275: Replace Digits

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

Task 2: Replace Digits

You are given an alphanumeric string, $str, where each character is either a letter or a digit.

Write a script to replace each digit in the given string with the value of the previous letter plus (digit) places.

Example 1

Input: $str = 'a1c1e1'
Ouput: 'abcdef'

shift('a', 1) => 'b'
shift('c', 1) => 'd'
shift('e', 1) => 'f'

Example 2

Input: $str = 'a1b2c3d4'
Output: 'abbdcfdh'

shift('a', 1) => 'b'
shift('b', 2) => 'd'
shift('c', 3) => 'f'
shift('d', 4) => 'h'

Example 3

Input: $str = 'b2b'
Output: 'bdb'

Example 4

Input: $str = 'a16z'
Output: 'abgz'

I have several comments about this task.

First, we're not told what to do if shifting a letter by a given offset leads to going past the last letter of the alphabet. For example, what is the value of shift('z', 2)? Shall we take the next character in the ASCII order? Or do we go back to the beginning of the alphabet, as in the Caesar cipher? We don't have any instruction here, so I'll not consider this case and just shift in the ASCII order, even though this may lead to unprintable characters (but not with the examples provided). It would not really be difficult to choose the other solution and rotate around the alphabet, but this is left as an exercise to the reader.

Next, we also don't know what to do with an input string starting with a digit, and also don't have an example clarifying that. I'll consider that this will not happen and that all input strings will start with an alphabetical character, as the examples provided.

Finally, we also don't know that to do with input string with two digits in a row. The task says to "to replace each digit in the given string with the value of the previous letter plus (digit) places." We cannot do that when the previous letter is not a letter, but a digit, unless we do that after the previous digit has already been converted to a letter. But then, I disagree with Example 4 ('a16z'): if we convert the third character ("6") after the second one ("1") has already been shifted to a "b", then the third letter ought to be a "h", not a "g".

Replace Digits in Raku

This solution should be viewed in the context of the above comments.

sub replace-digits ($in) {
    my @chars = $in.comb;
    for 1..@chars.end -> $i {
        if @chars[$i] ~~ /\d/ {
            @chars[$i] = chr( @chars[$i-1].ord + @chars[$i]);
        }
    }
    return join "", @chars;
}    

my @tests = 'a1c1e1', 'a1b2c3d4', 'b2b', 'a16z';
for @tests -> $test {
    printf "%-10s => ", $test;
    say replace-digits $test;
}

This program displays the following output:

$ raku ./replace-digits.raku
a1c1e1     => abcdef
a1b2c3d4   => abbdcfdh
b2b        => bdb
a16z       => abhz

Replace Digits in Perl

This a port to Perl of the above Raku program. All the comments above also apply here, including the reason why my result with the fourth example ("a16z") disagrees with the example provided in the task specification.

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

sub replace_digits {
    my @chars = split //, shift;
    for my $i (1..$#chars) {
        if ($chars[$i] =~ /\d/) {
            $chars[$i] = chr( $chars[$i] + ord $chars[$i-1]);
        }
    }
    return join "", @chars;
}    

my @tests = ('a1c1e1', 'a1b2c3d4', 'b2b', 'a16z');
for my $test (@tests) {
    printf "%-10s => ", $test;
    say replace_digits $test;
}

This program displays the following output:

$ perl ./replace-digits.pl
a1c1e1     => abcdef
a1b2c3d4   => abbdcfdh
b2b        => bdb
a16z       => abhz

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 July 7, 2024. Happy Independence Day to all my friends in the US. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 274: Goat Latin

These are some answers to the Week 274, Task 1, 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 June 23, 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: Goat Latin

You are given a sentence, $sentance.

Write a script to convert the given sentence to Goat Latin, a made up language similar to Pig Latin.

Rules for Goat Latin:

1) If a word begins with a vowel ("a", "e", "i", "o", "u"), append "ma" to the end of the word. 2) If a word begins with consonant i.e. not a vowel, remove first letter and append it to the end then add "ma". 3) Add letter "a" to the end of first word in the sentence, "aa" to the second word, etc etc.

Example 1

Input: $sentence = "I love Perl"
Output: "Imaa ovelmaaa erlPmaaaa"

Example 2

Input: $sentence = "Perl and Raku are friends"
Output: "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa"

Example 3

Input: $sentence = "The Weekly Challenge"
Output: "heTmaa eeklyWmaaa hallengeCmaaaa"

Goat Latin in Raku

The first thing is to define consonants: I decided to define it as the set of all upper-case and lower-case letters minus (in the sense of set difference) upper-case and lower-case vowels. The rest is just following the task description: remove the first letter from the beginning if t is a consonant, add "ma" and then add an "a" to the end of first word in the sentence, an "aa" to the second word, etc.*

sub goat-latin ($in) {
    my $consonants = (('a'..'z').Set ∪ ('A'..'Z').Set)
        (-) <a e i o u A E I O U>.Set;
    my @out;
    my $wc = 0;
    for $in.words -> $word {
        my $result = $word;
        $wc++;
        if (substr $result, 0, 1)  ∈ $consonants {
            $result = (substr $word, 1) ~ (substr $result, 0, 1);
        }
        $result ~= "ma";
        $result ~= 'a' x  $wc;
        push @out, $result;
    }
    return join " ", @out;
}
my @tests = "I love Perl", "Perl and Raku are friends",
    "The Weekly Challenge";
for @tests -> $test {
    say "English: $test";
    say "Goat Latin: ", goat-latin $test;
    say "-----";
}

This program displays the following output:

$ raku ./goat-latin.raku
English: I love Perl
Goat Latin: Imaa ovelmaaa erlPmaaaa
-----
English: Perl and Raku are friends
Goat Latin: erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa
-----
English: The Weekly Challenge
Goat Latin: heTmaa eeklyWmaaa hallengeCmaaaa

Goat Latin in Perl %vowel

This is a port to Perl of the above Raku program. The most significant difference is that we use a hash (%vowels) to store the vowels.

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

sub goat_latin {
    my $in = shift;
    my %vowels = map {$_ => 1} qw<a e i o u A E I O U>;
    my @out;
    my $wc = 0;
    for my $word (split /\s+/, $in) {
        $wc++;
        unless (defined $vowels{substr $word, 0, 1}) {
            $word = (substr $word, 1) . (substr $word, 0, 1);
        }
        $word .= "ma";
        $word .= 'a' x  $wc;
        push @out, $word;
    }
    return join " ", @out;
}
my @tests = ("I love Perl", "Perl and Raku are friends", "The Weekly Challenge");
for my $test (@tests) {
    say "English: $test";
    say "Goat Latin: ", goat_latin $test;
    say "-----";
}

This program displays the following output:

$ perl ./goat-latin.pl
English: I love Perl
Goat Latin: Imaa ovelmaaa erlPmaaaa
-----
English: Perl and Raku are friends
Goat Latin: erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa
-----
English: The Weekly Challenge
Goat Latin: heTmaa eeklyWmaaa hallengeCmaaaa
-----

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 June 30, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 273: B After A

These are some answers to the Week 273, 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 June 16, 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 2: B After A

You are given a string, $str.

Write a script to return true if there is at least one b, and no a appears after the first b.

Example 1

Input: $str = "aabb"
Output: true

Example 2

Input: $str = "abab"
Output: false

Example 3

Input: $str = "aaa"
Output: false

Example 4

Input: $str = "bbb"
Output: true

This is a perfect job for regexes, both in Perl and Raku.

B After A in Raku

Our solution is essentially a one-liner with a regex. Since the Raku regex syntax is slightly different from the canonical Perl or Perl-compatible regex syntax, let me briefly explain the regex pattern used in the program below. First, spaces are not significant in Raku regexes (unless explicitly specified otherwise), so they can be used to separate or regroup pattern pieces and make them more readable and easier to understand. The regex below is made of 5 pieces:

^       beginning of string
<-[b]>* a character class meaning anything other than "b", repeated 0
        or more times
b       a literal "b"
<-[a]>* a character class meaning anything other than "a", repeated 0
        or more times
$       end of string

This is now the full program:

sub b-after-a ($str) {
    return $str ~~ /^ <-[b]>* b <-[a]>* $/ ?? True !! False;
}

for <aabb abab aaa bbb> ->  $test {
    printf "%-5s => ", $test;
    say b-after-a $test;
}

This program displays the following output.

$ raku ./b-after-a.raku
aabb  => True
abab  => False
aaa   => False
bbb   => True

B After A in Perl

This is a port to Perl of the above Raku program.

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

sub b_after_a {
    return shift =~ /^[^b]*b[^a]*$/ ? "true" : "false";
}

for my $test (qw<aabb abab aaa bbb>) {
    printf "%-5s => ", $test;
    say b_after_a $test;
}

This program displays the following output.

$ perl ./b-after-a.pl
aabb  => true
abab  => false
aaa   => false
bbb   => true

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 June 23, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 273: Percentage of Character

These are some answers to the Week 273, Task 1, 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 June 16, 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: Percentage of Character

You are given a string, $str and a character $char.

Write a script to return the percentage, nearest whole, of given character in the given string.

Example 1

Input: $str = "perl", $char = "e"
Output: 25

Example 2

Input: $str = "java", $char = "a"
Output: 50

Example 3

Input: $str = "python", $char = "m"
Output: 0

Example 4

Input: $str = "ada", $char = "a"
Output: 67

Example 5

Input: $str = "ballerina", $char = "l"
Output: 22

Example 6

Input: $str = "analitik", $char = "k"
Output: 13

Percentage of Character in Raku

This is fairly easy. We just traverse the input string and count the number of occurrences of the given character. Finally, we compute the percentage to the string length and round it to the nearest integer with the round method.

sub percent ($str, $char) {
    my $count = 0;
    for $str.comb -> $ch {
        $count++ if $ch eq $char;
    }
    return (($count * 100) / $str.chars).round;
}

my @tests = <perl e>, <java a>, <python m>,
            <ada a>, <ballerina l>, <analitik k>;
for @tests -> @test {
    printf "%-10s - %-2s => ", @test;
    say percent @test[0], @test[1];
}

This program displays the following output.

$ raku ./percentage-of-character.raku
perl       - e  => 25
java       - a  => 50
python     - m  => 0
ada        - a  => 67
ballerina  - l  => 22
analitik   - k  => 13

Percentage of Character in Perl

This is a port to Perl of the above Raku program. Perl doesn't have a built-in round function, but it's easy to simulate it with the int function.

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

sub percent {
    my ($str, $char) = @_;
    my $count = 0;
    for my $ch (split //, $str) {
        $count++ if $ch eq $char;
    }
    return int (0.5 + ($count * 100) / (length $str));
}

my @tests = ( [<perl e>], [<java a>], [<python m>],
            [<ada a>], [<ballerina l>], [<analitik k>] );
for my $test (@tests) {
    printf "%-10s - %-2s => ", $test->[0], $test->[1];
    say percent @$test;
}

This program displays the following output.

$ perl  ./percentage-of-character.pl
perl       - e  => 25
java       - a  => 50
python     - m  => 0
ada        - a  => 67
ballerina  - l  => 22
analitik   - k  => 13

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 June 23, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 272: String Score

These are some answers to the Week 272, 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 June 9, 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 2: String Score

You are given a string, $str.

Write a script to return the score of the given string.

The score of a string is defined as the sum of the absolute difference between the ASCII values of adjacent characters.

Example 1

Input: $str = "hello"
Output: 13

ASCII values of characters:
h = 104
e = 101
l = 108
l = 108
o = 111

Score => |104 - 101| + |101 - 108| + |108 - 108| + |108 - 111|
      => 3 + 7 + 0 + 3
      => 13

Example 2

Input: "perl"
Output: 30

ASCII values of characters:
p = 112
e = 101
r = 114
l = 108

Score => |112 - 101| + |101 - 114| + |114 - 108|
      => 11 + 13 + 6
      => 30

Example 3

Input: "raku"
Output: 37

ASCII values of characters:
r = 114
a = 97
k = 107
u = 117

Score => |114 - 97| + |97 - 107| + |107 - 117|
      => 17 + 10 + 10
      => 37

In some programming languages, you can subtract characters directly. For example, 'c' - 'a' would yield 2. In Perl and in Raku, you need to use the ord method or function to explicitly convert characters to their ASCII values before you can perform the subtraction..

String Score in Raku

Not much to say. We loop through the letters of the input string, convert them to ASCII values, perform the subtraction and add the absolute value of the difference to the result.

sub string-score ($in) {
    my $result = 0;
    my @let = $in.comb;
    for 1 .. @let.end -> $i {
        $result += (@let[$i].ord - @let[$i - 1].ord).abs;
    }
    return $result;
}
for <hello perl raku> -> $test {
    printf "%-8s => ", $test;
    say string-score $test;
}

This program displays the following output:

$ raku ./string-score.raku
hello    => 13
perl     => 30
raku     => 37

String Score in Perl

This is a port to Perl of the above Raku program.

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

sub string_score {
    my $result = 0;
    my @let = split //, shift;
    for my $i (1 .. $#let) {
        $result += abs (ord($let[$i]) - ord($let[$i - 1]));
    }
    return $result;
}
for my $test (qw<hello perl raku>) {
    printf "%-8s => ", $test;
    say string_score $test;
}

This program displays the following output:

$ perl string-score.pl
hello    => 13
perl     => 30
raku     => 37

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 June 16, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 272: Defang IP Address

These are some answers to the Week 272, Task 1, 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 June 9, 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: Defang IP Address

You are given a valid IPv4 address.

Write a script to return the defanged version of the given IP address.

A defanged IP address replaces every period “.” with “[.]".

Example 1

Input: $ip = "1.1.1.1"
Output: "1[.]1[.]1[.]1"

Example 2

Input: $ip = "255.101.1.0"
Output: "255[.]101[.]1[.]0"

This the first time that I hear that an IP address could be "defanged."

Defang IP Address in Raku

To replace periods, ".", with "[.]", we can simply use a regex substitution. The only very slight difficulty is that a period or dot in a meta-character (a wild card matching any character), so to obtain literal matching of a period in the search pattern, we need to escape it (\.) or to quote it ('.').

sub defang-ip ($in is copy) {
    $in ~~ s:g/\./[.]/;
    return ~$in;
}

my @tests = "1.1.1.1", "255.101.1.0", "255.255.255.255";
for @tests -> $test {
    printf "%-16s => ", $test;
    say defang-ip $test;
}

This program displays the following output:

$ raku ./defang-ip.raku
1.1.1.1          => 1[.]1[.]1[.]1
255.101.1.0      => 255[.]101[.]1[.]0
255.255.255.255  => 255[.]255[.]255[.]255

Of course, the solution is simple enough to make a Raku one-line possible and easy:

$ raku -e 'my $in = shift @*ARGS; $in ~~ s:g/\./[.]/; say $in;' "255.101.1.0"
255[.]101[.]1[.]0

Defang IP Address in Perl

This is a port to Perl of the Raku program above, using the same regular expression substitution (and also with the need yo escape the period in the search pattern).

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

sub defang_ip {
    $_[0] =~ s/\./[.]/g;
    return $_[0] ;
}

my @tests = ("1.1.1.1", "255.101.1.0", "255.255.255.255");
for my $test (@tests) {
    printf "%-16s => ", $test;
    say defang_ip $test;
}

This program displays the following output:

$ perl ./defang-ip.pl
1.1.1.1          => 1[.]1[.]1[.]1
255.101.1.0      => 255[.]101[.]1[.]0
255.255.255.255  => 255[.]255[.]255[.]255

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 June 16, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.