These are some answers to the Week 288, 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 September 29, 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: Closest Palindrome

You are given a string, $str, which is an integer.

Write a script to find out the closest palindrome, not including itself. If there are more than one then return the smallest.

The closest is defined as the absolute difference minimized between two integers.

Example 1

Input: $str = "123"
Output: "121"

Example 2

Input: $str = "2"
Output: "1"

There are two closest palindrome "1" and "3". Therefore we return the smallest "1".

Example 3

Input: $str = "1400"
Output: "1441"

Example 4

Input: $str = "1001"
Output: "999"

Closest Palindrome in Raku

To find if a number is a palindrome, we simply flip it and check whether the result is equal to the original number. We start with a gap equal to 1, and check whether the original number minus the gap is a palindrome or whether the original number plus the gap is a palindrome. If any is a palindrome, we return it to the caller. If not, we continue with a gap of 2, and then 3, 4, etc.

sub closest-palindrome ($in) {
    for 1..Inf -> $i {
        return $in - $i if ($in - $i).flip eq $in - $i;
        return $in + $i if ($in + $i).flip eq $in + $i;
    }
}

my @tests = 123, 2, 1400, 1001;
for @tests -> $test {
    printf "%-6d => ", $test;
    say closest-palindrome $test;
}

This program displays the following output:

$ raku ./closest-palindrome.raku
123    => 121
2      => 1
1400   => 1441
1001   => 999

Closest Palindrome in Raku

This is a port to Perl of the above Raku program. Please see the previous section if you need further explanation. The equivalent of flip in Perl is reverse (in scalar context).

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

sub closest_palindrome {
    my $in = shift;
    my $i = 1;
    while (1) {
        return $in - $i if reverse($in - $i) eq $in - $i;
        return $in + $i if reverse($in + $i) eq $in + $i;
        $i++;
    }
}

my @tests = (123, 2, 1400, 1001);
for my $test (@tests) {
    printf "%-6d => ", $test;
    say closest_palindrome $test;
}

This program displays the following output:

$ perl ./closest-palindrome.pl
123    => 121
2      => 1
1400   => 1441
1001   => 999

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

These are some answers to the Week 287, 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 September 22, 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: Valid Number

You are given a string, $str.

Write a script to find if it is a valid number.

Conditions for a valid number:

- An integer number followed by an optional exponent.
- A decimal number followed by an optional exponent.
- An integer number is defined with an optional sign '-' or '+' followed by digits.

Decimal Number:

A decimal number is defined with an optional sign '-' or '+' followed by one of the following definitions: - Digits followed by a dot '.'. - Digits followed by a dot '.' followed by digits. - A dot '.' followed by digits.

Exponent:

An exponent is defined with an exponent notation 'e' or 'E' followed by an integer number.

Example 1

Input: $str = "1"
Output: true

Example 2

Input: $str = "a"
Output: false

Example 3

Input: $str = "."
Output: false

Example 4

Input: $str = "1.2e4.2"
Output: false

Example 5

Input: $str = "-1."
Output: true

Example 6

Input: $str = "+1E-8"
Output: true

Example 7

Input: $str = ".44"
Output: true

Valid Number in Raku

We could implement a regex one-liner, something like this:

/<[+-]> (\d+\.? \d*) | (\. \d+) ...

However, I find it more convenient and more maintainable to use a relatively advanced feature of Raku regexes, named captures, or, even better, named regexes, which come in three flavors: regexes, tokens and rules. They are the main ingredient for grammars, but it is convenient to use them as building blocks, even when implementing a full-fledged grammar might be technological overkill. The syntax for defining them is similar to a subroutine or method definition, for example:

my token sign { <[+-]> }

Once you have defined the sign token as above, you can use it with the <sign> name.

The program below shows multiple uses of named regexes as building blocks for more complicated ones.

sub valid-number ($in) {
    my token sign { <[+-]> }
    my regex integer { <sign>? \d+ }
    my token exponent { <[eE]> <integer> }
    my token decimal { 
        <integer> '.'? | <sign>? '.'? \d+ | <integer> '.' \d+
    }
    my regex float { <decimal> <exponent> }
    my token number { <float> | (<decimal> <exponent>?) }

    return so $in ~~ /^ <number> $/ ;
}

for <1 a . 1.2e4.2 -1 +1E-8 .44 16 12.5 5e17e3 foo> -> $test {
    printf "%-10s => ", $test;
    say valid-number $test; 
}

This program displays the following output:

$ raku ./valid-number.raku
1          => True
a          => False
.          => False
1.2e4.2    => False
-1         => True
+1E-8      => True
.44        => True
16         => True
12.5       => True
5e17e3     => False
foo        => False

Valid Number in Perl

Perl doesn't have named regexes, so we will use standard Perl regexes, with the /x option to enable spaces and comments within the regex.

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

sub valid_number {
    my $in = shift;
    return "True" if $in =~
      /^[+-]?         # start of string & optional + or - sign
        ( \d+\.?      # digit(s) followed by a dot
        | \d*\.\d+)   # or digits with a dot inside or before
        ([eE][+-]\d+)? # optional positive or negative exponent
      $/x;            # end of string & option to enable comments
    return "False";
}
my @tests = qw<1 a . 1.2e4.2 -1 +1E-8 .44 16 12.5 5e17e3 foo>;
for my $test (@tests) {
    printf "%-10s => ", $test;
    say valid_number $test;
}

This program displays the following output:

$ perl valid-number.pl
1          => True
a          => False
.          => False
1.2e4.2    => False
-1         => True
+1E-8      => True
.44        => True
16         => True
12.5       => True
5e17e3     => False
foo        => False

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

These are some answers to the Week 287, 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 September 22, 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: Strong Password

You are given a string, $str.

Write a program to return the minimum number of steps required to make the given string very strong password. If it is already strong then return 0.

Criteria:

- It must have at least 6 characters.
- It must contain at least one lowercase letter, at least one upper case letter and at least one digit.
- It shouldn't contain 3 repeating characters in a row.

Following can be considered as one step:

- Insert one character
- Delete one character
- Replace one character with another

Example 1

Input: $str = "a"
Output: 5

Example 2

Input: $str = "aB2"
Output: 3

Example 3

Input: $str = "PaaSW0rd"
Output: 0

Example 4

Input: $str = "Paaasw0rd"
Output: 1

Example 5

Input: $str = "aaaaa"
Output: 3

My strategy will be as follows. If the input string doesn't contain an uppercase letter (we check that with a regex), then we add an uppercase letter (an "A"). We do the same for lowercase letters and for digits. Then we check for sequences of 3 repeated characters and replace the last one with the next letter in the alphabet (or anything that comes next in the ASCII table). Finally, and only then, we check the length. This way, we might have started with a password that was too short, but may have made it longer through the addition of some characters in the previous steps.

Strong Password in Raku

See the previous section for the overall strategy. In Raku, we use the regexes' predefined character classes (or Unicode properties) <:Lu> (uppercase letter) and <:Ll> (lowercase letter) for finding uppercase and lowercase letters. For sequences of 3 repeated characters, we look for any letter followed by two repetitions of it with the /(.)$0**2/ regex; when we find such a sequence, we replace the third character by another (the next one in the alphabet).

sub strong-password ($pwd is copy) {
    my $count = 0;
    # At least one uppercase letter
    $pwd ~= "A" and $count++ if $pwd !~~ /<:Lu>/; 
    # At least one lowercase letter
    $pwd ~= "b" and $count++ if $pwd !~~ /<:Ll>/;
    # At least one digit
    $pwd ~= "3" and $count++ if $pwd !~~ /\d/;
    # no repeating characters
    while $pwd ~~ /(.)$0**2/ {
        my $subst = ($0.ord + 1).chr;
        $pwd ~~ s/(.)$0**2/$0$0$subst/;
        $count++;
    }
    for 'a'..'z' -> $ch {
        last if $pwd.chars >= 6;
        $count++;
        $pwd ~= $ch
    }
    return $count;
} 

my @tests = <a aB2 PaaSW0rd Paaasw0rd aaaaa foob>;
for @tests -> $test {
    printf "%-10s => ", $test;
    say strong-password $test;
}

This program displays the following output:

$ raku ./strong-password.raku
a          => 5
aB2        => 3
PaaSW0rd   => 0
Paaasw0rd  => 1
aaaaa      => 3
foob       => 2

Strong Password in Perl

This is a port to Perl of the Raku program above. Please refer to the comments in the two sections above if you need further explanations. Perl doesn't have built-in character classes for uppercase or lowercase letters, but it's very easy to define them, using for example [A-Z]for the uppercase character class.

use strict;
use warnings;
use feature 'say'; uppercase chara cter class

sub strong_password {
    my $pwd = shift;
    my $count = 0;
    # At least one uppercase letter
    $pwd .= "A" and $count++ if $pwd !~ /[A-Z]/; 
    # At least one lowercase letter
    $pwd .= "b" and $count++ if $pwd !~ /[a-z]/;
    # At least one digit
    $pwd .= "3" and $count++ if $pwd !~ /\d/;
    # no repeating characters
    while ($pwd =~ /(.)\1{2}/) {
        my $subst = chr (1 + ord $1);
        $pwd =~ s/(.)$1{2}/$1$1$subst/;
        $count++;
    }
    for my $ch ('a'..'z') {
        last if length $pwd >= 6;
        $count++;
        $pwd .= $ch
    }
    return $count;
} 

my @tests = qw<a aB2 PaaSW0rd Paaasw0rd aaaaa foob>;
for my $test (@tests) {
    printf "%-10s => ", $test;
    say strong_password $test;
}

This program displays the following output:

$ perl ./strong-password.pl
a          => 5
aB2        => 3
PaaSW0rd   => 0
Paaasw0rd  => 1
aaaaa      => 3
foob       => 2

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

These are some answers to the Week 286, 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 September 15, 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: Order Game

You are given an array of integers, @ints, whose length is a power of 2.

Write a script to play the order game (min and max) and return the last element.

Example 1

Input: @ints = (2, 1, 4, 5, 6, 3, 0, 2)
Output: 1

Operation 1:

    min(2, 1) = 1
    max(4, 5) = 5
    min(6, 3) = 3
    max(0, 2) = 2

Operation 2:

    min(1, 5) = 1
    max(3, 2) = 3

Operation 3:

    min(1, 3) = 1

Example 2

Input: @ints = (0, 5, 3, 2)
Output: 0

Operation 1:

    min(0, 5) = 0
    max(3, 2) = 3

Operation 2:

    min(0, 3) = 0

Example 3

Input: @ints = (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8)
Output: 2

Operation 1:

    min(9, 2) = 2
    max(1, 4) = 4
    min(5, 6) = 5
    max(0, 7) = 7
    min(3, 1) = 1
    max(3, 5) = 5
    min(7, 9) = 7
    max(0, 8) = 8

Operation 2:

    min(2, 4) = 2
    max(5, 7) = 7
    min(1, 5) = 1
    max(7, 8) = 8

Operation 3:

    min(2, 7) = 2
    max(1, 8) = 8

Operation 4:

    min(2, 8) = 2

Order Game in Raku

We loop over the input array (@in), picking two items ($iand $j) each time, compute and store the min or max into a new array (@next-list). At the end of this loop, we replace @in by the new array, and start all over again. The process stops when there is only one element left in the array.

To know whether we need to perform max or min, we set a Boolean variable ($min) to true before we start and negate its value at each step of the process. If $min is true, then we need to compute the min, if it is false, then we compute the max.

sub order-game (@in is copy) {
    my $min = True;
    loop {
        my @next-list;
        for @in -> $i, $j {
            my $new = $min ?? min $i, $j !! max $i, $j;
            push @next-list, $new;
            $min = not $min;
        }
        return @next-list[0] if @next-list.elems == 1;
        @in = @next-list;
    }
}

my @tests = (2, 1, 4, 5, 6, 3, 0, 2), (0, 5, 3, 2),
            (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8);
for @tests -> @test {
    printf "%-8s ... => ", "@test[0..3]";
    say order-game @test;
}

This program displays the following output:

$ raku ./order-game.raku
2 1 4 5  ... => 1
0 5 3 2  ... => 0
9 2 1 4  ... => 2

Note that we display only the four first items of the input array for reasons having to do with the formatting of this blog post (to avoid too long lines).

That works fine, but you may want to look below for a simpler solution.

Order Game in Perl

For solving the task in Perl, we first need to have some min and max subroutines. Since I believe it is not really fair to use an off-the-shelf software component for a coding challenge, I wrote two auxiliary subroutines on this model:

sub max { $_[0] > $_[1] ? $_[0] : $_[1]; }

My next task was to port the Raku order-game subroutine to Perl, as I usually do. At this point, it came to my mind that there might be a simpler solution. Instead of using two nested loops, we could use a single loop on a circular buffer, i.e. an array where, at each step of the process, we pick and remove two items from the beginning and add the min or max, as the case may be, at the end of the array. Most of the time, I copy the arguments into new variables but, here, I decided to work directly on @_ because it is simpler to shift from it. The drawback it that it modifies the subroutine arguments on the caller side, but we don't care since they are no longer used.

To know whether we need max or min, we set a Boolean variable ($min) to a true value (1) before we start and negate its value at each step of the process. If $min is true, then we need to compute the min, if it is false, then we compute the max.

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

sub max { $_[0] > $_[1] ? $_[0] : $_[1]; }

sub min { $_[0] > $_[1] ? $_[1] : $_[0]; }

sub order_game {
    my $min = 1;
    my @in = @_;
    while (1) {
        my ($i, $j) = (shift, shift);
        push @_, $min ? min($i, $j) : max $i, $j;
        $min = not $min;
        return $_[0] if @_ == 1;
    } 
}

my @tests = ([2, 1, 4, 5, 6, 3, 0, 2], [0, 5, 3, 2],
            [9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8]);
for my $test (@tests) {
    printf "%-8s ... => ", "@$test[0..3]";
    say order_game @$test;
}

This program displays the following output:

$ perl ./order-game.pl
2 1 4 5  ... => 1
0 5 3 2  ... => 0
9 2 1 4  ... => 2

Order Game in Raku, revisited

Since this Perl solution is better than the previous Raku implementation, I thought it would be nice to back port the Perl program to Raku.

sub order-game (@in is copy) {
    my $min = True;
    loop {
        my @pair = @in.splice(0, 2);
        push @in, $min ?? min @pair !! max @pair;
        $min = not $min;
        return @in[0] if @in.elems == 1;
    }
}

my @tests = (2, 1, 4, 5, 6, 3, 0, 2), (0, 5, 3, 2),
            (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8);
for @tests -> @test {
    printf "%-8s ... => ", "@test[0..3]";
    say order-game @test;
}

This program displays the same output as its previous version:

$ raku ./order-game-2.raku
2 1 4 5  ... => 1
0 5 3 2  ... => 0
9 2 1 4  ... => 2

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

These are some answers to the Week 286, 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 September 15, 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: Self Spammer

Write a program which outputs one word of its own script / source code at random. A word is anything between whitespace, including symbols.

Example 1

If the source code contains a line such as: 'open my $fh, "<", "ch-1.pl" or die;'
then the program would output each of the words { open, my, $fh,, "<",, "ch-1.pl", or, die; }
(along with other words in the source) with some positive probability.

Example 2

Technically 'print(" hello ");' is *not* an example program, because it does not
assign positive probability to the other two words in the script.
It will never display print(" or ");

Example 3

An empty script is one trivial solution, and here is another:
echo "42" > ch-1.pl && perl -p -e '' ch-1.pl

I do not understand the comment of Example 2. Given the definition provided for a word, the print(" hello "); program is made of three words which could equally be selected by a random process.

Self Spammer in Raku

First, we can use the $?FILE compile-time variable to access to the name of the file being run by the Raku compiler. Then we use the IO method to access the content of the file, and the words method to split the input file into words. Finally, we use the pick method to retrieve a single random item from the word list.

So the program might be a simple one-liner: say $?FILE.IO.words.pick;.

The only problem with this is that we have only two words, which makes the output not very interesting. So, I added one comment line to get a larger variety of words for the output.

# this is a comment line aimed at getting more words
say $?FILE.IO.words.pick;

This program ran five times and displayed the following output:

$ ./raku self-spammer.raku
is

$ raku ./self-spammer.raku
this

$ raku ./self-spammer.raku
say

$ raku ./self-spammer.raku
comment

$ raku ./self-spammer.raku
$?FILE.IO.words.pick;

Self Spammer in Perl

In Perl, we will read the program file (from the __FILE__ special variable) line by line, split each such line on white spaces et store the words into the @words array. Finally, we use the rand function to pick a single random item from the word list. Note that I had to strip leading spaces from each line to prevent "empty" words to be added to the word list.

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

my @words;
open my $FH, '<', __FILE__ or die "Error opening file";
while (<$FH>) {
    s/^\s+//g;    # remove leading spaces from $_ if any
    push @words, split /\s+/, $_;
}
close $FH;
say $words[int(rand($#words + 1))];

This program ran six times and displayed the following output:

$ perl ./self-spammer.pl
=~

$ perl ./self-spammer.pl
use

$ perl ./self-spammer.pl
s/^\s+//g;

$ perl ./self-spammer.pl
"Error

$ perl ./self-spammer.pl
+

$ perl ./self-spammer.pl
opening

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

These are some answers to the Week 285, 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 September 8, 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: Making Change

Compute the number of ways to make change for given amount in cents. By using the coins e.g. Penny, Nickel, Dime, Quarter and Half-dollar, in how many distinct ways can the total value equal to the given amount? Order of coin selection does not matter.

A penny (P) is equal to 1 cent.
A nickel (N) is equal to 5 cents.
A dime (D) is equal to 10 cents.
A quarter (Q) is equal to 25 cents.
A half-dollar (HD) is equal to 50 cents.

Example 1

Input: $amount = 9
Ouput: 2

1: 9P
2: N + 4P

Example 2

Input: $amount = 15
Ouput: 6

1: D + 5P
2: D + N
3: 3N
4: 2N + 5P
5: N + 10P
6: 15P

Example 3

Input: $amount = 100
Ouput: 292

Making Change in Raku

I first thought of populating a hash which, for each coin value, would provide the number of ways such value could be made of smaller change. But this turned out to be too complicated by hand. So, I thought we could use a recursive subroutine to build that hash, but, at this point, we can use a similar recursive subroutine to compute directly the number of ways to construct the input amount.

Here, make-change is the recursive subroutine. It loops on the coin values (in descending order) and subtract the value from the input amount. If the amount left ($rest) is equal to zero, then we've found a new combination of coins and increment the count. Otherwise, we call recursively the make-change subroutine with the value of $rest.

The initial program did not work as expected because it found duplicate combinations (in different orders). For example, for in input value of 11, it might find the following combinations:

1 10
1 5 5
5 1 5
5 5 1
etc.

To prevent this, a second parameter, $limit, was added to the make-change subroutine by which we forbid the program to use coins with a value larger than the current one.

my @coins = 50, 25, 10, 5, 1;
my $count;

sub make-change ($amount, $limit) {
    for @coins -> $coin {
        next if $coin > $amount;
        # Prevent duplicate combinations in different orders
        next if $coin > $limit;
        my $rest = $amount - $coin;
        if $rest == 0 {
            $count++;
        } else {
            make-change($rest, $coin);
        }
    }
    return $count;
}

my @tests = 9, 15, 100;
for @tests -> $test {
    $count = 0;
    printf "%-5d => ", $test;
    say make-change $test, 50;
}

This program displays the following output:

$ raku ./make-change.raku
9     => 2
15    => 6
100   => 292

Note that I initially had some concerns about performance with all these recursive calls, but it turned out that the program ran quite fast:

$ time raku ./make-change.raku
9     => 2
15    => 6
100   => 292

real    0m0.830s
user    0m0.000s
sys     0m0.015s

Making Change in Perl

This is a port to Perl of the above Raku program. Please refer to the above section if you need explanations.

Note that I had to add the following pragma:

no warnings 'recursion';

to disable a warning about deep recursion, presumably when computing the combinations of pennies with an input value of 100. BTW, with today's computer hardware, the built-in recursion depth limit could be raised to a significantly higher level.

use strict;
use warnings;
no warnings 'recursion';
use feature 'say';

my @coins = (50, 25, 10, 5, 1);
my $count;

sub make_change  {
    my ($amount, $limit) = @_;
    for my $coin (@coins)  {
        next if $coin > $amount;
        # Prevent duplicate combinations in different orders
        next if $coin > $limit;
        my $rest = $amount - $coin;
        if ($rest == 0) {
            $count++;
        } else {
            make_change($rest, $coin);
        }
    }
    return $count;
}

my @tests = (9, 15, 50, 100);
for my $test (@tests) {
    $count = 0;
    printf "%-5d => ", $test;
    say make_change $test, 50;
}

This program displays the following output:

$ perl ./make-change.pl
9     => 2
15    => 6
100   => 292

I also benchmarked this Perl implementation, and it shows that, at least for such highly recursive programs, Perl is still much faster than Raku:

$ time perl ./make-change.pl
9     => 2
15    => 6
100   => 292

real    0m0.035s
user    0m0.000s
sys     0m0.030s

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

These are some answers to the Week 285, 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 September 8, 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: No Connection

You are given a list of routes, @routes.

Write a script to find the destination with no further outgoing connection.

Example 1

Input: @routes = (["B","C"], ["D","B"], ["C","A"])
Output: "A"

"D" -> "B" -> "C" -> "A".
"B" -> "C" -> "A".
"C" -> "A".
"A".

Example 2

Input: @routes = (["A","Z"])
Output: "Z"

The task specification isn't very clear, but the examples are more or less self-explanatory. Basically, we're given a list of point pairs (a start- and an end-point) and we look for an end-point which doesn't exist as a start-point.

Although it wouldn't be too difficult to check, we will assume that the input list of routes is correct and that there is always one (and only one) end-point satisfying the above rule.

No Connection in Raku

We're looking for the end-point that is not a start-point. In Raku, this can easily be done using the set difference,infix%E2%88%96) between the list of end-points and the list of start-points. For the sake of clarity, we first built two arrays (@starts and @ends) and then compute the set difference. Note that, if its arguments are lists or arrays, the set difference operator coerces its arguments into sets.

sub no-connection (@in) {
    my @starts = map { .[0] }, @in;
    my @ends = map { .[1] }, @in;
    return ~ (@ends (-) @starts);
}

    my @tests = (("B","C"), ("D","B"), ("C","A")), (("A","Z"),);
for @tests -> @test {
    printf "%-20s => ", @test.gist;
    say no-connection @test;
}

This program displays the following output:

$ raku no-connection.raku
((B C) (D B) (C A))  => A
((A Z))              => Z

Note that the no-connection subroutine could be boiled down to a Raku one-liner:

sub no-connection (@in) {
    return ~((map {.[1]}, @in) (-) (map {.[0]}, @in));
}

This new shorter version yields the same result, but is, in my humble opinion, slightly less clear.

No Connection in Perl

There is no set difference in Perl (and no sets for that matter), but we can easily hand roll the functionality using an array and a hash, keeping the array item that doesn't exist in the hash.

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

sub no_connection {
    my %starts = map { $_->[0] => 1} @_;
    my @ends = map { $_->[1] } @_;
    return grep {not exists $starts{$_}} @ends;
}

my @tests = ([["B","C"], ["D","B"], ["C","A"]], [["A","Z"]]);
for my $test (@tests) {
    printf "%-20s => ", join " ", map {"(@{$test->[$_]})"} 
        0..scalar @$test - 1;
    say no_connection @$test;
}

This program displays the following output:

$ perl no-connection.pl
(B C) (D B) (C A)    => A
(A Z)                => Z

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