laurent_r

These are some answers to the Week 279, 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 July 28, 2024 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Split String

You are given a string, $str.

Write a script to split the given string into two containing exactly same number of vowels and return true if you can otherwise false.

Example 1

Input: $str = "perl"
Ouput: false

Example 2

Input: $str = "book"
Ouput: true

Two possible strings "bo" and "ok" containing exactly one vowel each.

Example 3

Input: $str = "good morning"
Ouput: true

Two possible strings "good " and "morning" containing two vowels each or "good m" and "orning" containing two vowels each.

We are asked to say whether the input string can be split into two substrings containing the same number of vowels. This can always be done if the input string contains an even number of vowels, and can never be done if it contains an odd number of vowels. So all we need to do it to count the vowels and return "True" if the count is even, and "False otherwise'.

Split String in Raku

As said above, we want to count the vowels in the input string. We use the comb method (with a regex matching vowels and an ignore-caseadverb) to get the vowels, count them with the elems method and find out whether the count can be evenly divided by 2, using the %% operator. We end up with a one-liner subroutine:

sub split-string ($in) {
    return $in.comb(/:i <[aeiou}]>/).elems %% 2;
}

for "Perl", "book", "bOok", "good morning" -> $test {
    printf "%-15s => ", $test;
    say split-string $test;
}

This program displays the following output:

$ raku ./split-string.raku
Perl            => False
book            => True
bOok            => True
good morning    => True

Split String in Perl

This is a port to Perl of the above Raku program. Not much to say about this port, except that we return "true" or "false" as strings.

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

sub split_string {
    my @vowels = grep {/[aeiou]/i} split "", shift;
    scalar @vowels % 2 == 0 ? "true" : "false";

}

for my $test ("Perl", "book", "bOok", "good morning") {
    printf "%-12s => ", $test;
    say split_string $test;
}

This program displays the following output:_

$ perl ./split-string.pl
Perl         => false
book         => true
bOok         => true
good morning => 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 August 4, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 279, 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 July 28, 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: Sort Letters

You are given two arrays, @letters and @weights.

Write a script to sort the given array @letters based on the @weights.

Example 1

Input: @letters = ('R', 'E', 'P', 'L')
       @weights = (3, 2, 1, 4)
Output: PERL

Example 2

Input: @letters = ('A', 'U', 'R', 'K')
       @weights = (2, 4, 1, 3)
Output: RAKU

Example 3

Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T')
       @weights = (5, 4, 2, 6, 1, 3)
Output: PYTHON

Sort Letters in Raku

We need some way of combining the data of the two arrays to be able to sort the items of the @letters array in accordance with the values of the @weights array. For example, we could build an intermediate data structure of records containing each a letter and the value of its weight, sort his data structure in accordance with the weight and then extract the letters from the sorted data structure.

We don't need, however to create a new variable to contain an array with this intermediate data structure. We will use an anonymous array of pairs to host this data structure and perform the required operations on a data pipeline. The solution is often called Schwartzian Transform, because it was suggested by Randall Schwartz on a Perl newsgroup back in 1995, in the early days of Perl 5.

A literal translation to Raku of the canonical Perl Schwartzian Transform might look like this:

sub sort-letters (@letters, @weights) {
    return join "", map { $_[0] }, 
    sort { $^a[1] <=> $^b[1] }, 
    map { @letters[$_], @weights[$_] }, 0..@letters.end;
}

When trying to understand this construct, it is probably best to read from bottom to top, and from right to left. On the last line, the 0..@letters.end code at the end creates a list of subscripts used in the beginning of that line to create an anonymous array of arrays. The next line upwards sorts the data according to the weights and, finally, the map on the first line extracts the letters from sorted array.

This is, as I said, a Raku translation of how we would do it in Perl. But Raku offers some opportunities for improvement. In Raku, when the code block or subroutine called by sort takes only one parameter, then it specifies not the comparison subroutine, but the transformation to be applied to each item of the input data before sorting. So, we can simplify our Schwartzian Transform as follows:

sub sort-letters2 (@letters, @weights) {
    return join "", map { $_[0] }, sort { $_[1] }, 
    map { @letters[$_], @weights[$_] }, 0..@letters.end;
}

In addition, the creation of the intermediate data strucure can be greatly simplified using the zip routine, leading to a one-line Schwartzian Transform. We now display the full program:

sub sort-letters3 (@let, @w) {
    join "", map { $_[0] }, sort { $_[1] }, zip @let, @w;
}

my @tests = (< R E P L>, <3 2 1 4>),
            (<A U R K>, <2 4 1 3>),
            (<O H Y N P T>, <5 4 2 6 1 3>);
for @tests -> @test {
    printf "%-14s => ", "@test[0]";
    say sort-letters3 @test[0], @test[1];
}

This program (as well as its previous versions) displays the following output:

$ raku ./sort-letters.raku
R E P L        => PERL
A U R K        => RAKU
O H Y N P T    => PYTHON

Sort Letters in Perl

This is a port to Perl of the first Raku program above, with the original implementation of the Schwartzian Transform. Please refer to the above section if you need explanations.

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

sub sort_letters {
    my @letters = @{$_[0]};
    my @indices = @{$_[1]};
    return map $_->[0], sort { $$a[1] <=> $$b[1] } 
    map [ $letters[$_], $indices[$_] ], 0..$#letters;
}

my @tests = ( [ [< R E P L>], [<3 2 1 4>] ],
              [ [<A U R K>], [<2 4 1 3>] ],
              [ [<O H Y N P T>], [<5 4 2 6 1 3>] ] );
for my $test (@tests) {
    printf "%-14s => ", "@{$test->[0]}";
    say sort_letters $test->[0], $test->[1];
}

This program displays the following output:

$ perl  ./sort-letters.pl
R E P L        => PERL
A U R K        => RAKU
O H Y N P T    => PYTHON

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

These are some answers to the Week 278, 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 July 21, 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: Reverse Word

You are given a word, $word and a character, $char.

Write a script to replace the substring up to and including $char with its characters sorted alphabetically. If the $char doesn’t exist, then DON'T do anything.

Example 1

Input: $str = "challenge", $char = "e"
Ouput: "acehllnge"

Example 2

Input: $str = "programming", $char = "a"
Ouput: "agoprrmming"

Example 3

Input: $str = "champion", $char = "b"
Ouput: "champion"

This task is not at all about reversing words, but I kept the title provided in the task description for proper reference.

Reverse Word in Raku

First, we use the index built-in routine to find the position of the first occurrence of $char in the input string. Then, we split the substring up to char into an array of individual characters and sort this array alphabetically (in ascending order), and join the characters into a string to provide the $prefix. We use the substr routine to extract the suffix, and stitch together the prefix and the suffix.

sub shuffle-word ($word is copy, $char) {
    my $ind = index $word, $char;
    return $word unless $ind;
    my $prefix = join "", sort $word.comb[0..$ind];
    return $prefix ~ substr $word, $ind + 1;
}

my @tests = <challenge e>, <programming a>, <champion, b>; 
for @tests -> @test {
    printf "%-12s %-2s => ", @test;
    say shuffle-word @test[0], @test[1];
}

This program displays the following output:

$ raku ./reverse-word.raku
challenge    e  => acehllnge
programming  a  => agoprrmming
champion,    b  => champion,

Reverse Word in Perl

This is a port to Perl of the above Raku program. There are a few syntax differences, but the basic built-in functions, index and substr, have essentially the same syntax in Perl and in Raku (at least for our purposes).

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

sub shuffle_word {
    my ($word, $char) = @_;
    my $ind = index $word, $char;
    return $word unless $ind;
    my @prefix_letters = (split //, $word)[0..$ind];
    my $prefix = join "", sort @prefix_letters;
    return $prefix . substr $word, $ind + 1;
}

my @tests = ( [ qw<challenge e> ], 
              [ qw<programming a> ], 
              [ qw<champion b> ] ); 
for my $test (@tests) {
    printf "%-12s %-2s => ", @$test;
    say shuffle_word @$test;
}

This program displays the following output:

$ perl ./reverse-word.pl
challenge    e  => acehllnge
programming  a  => agoprrmming
champion     b  => champion

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

These are some answers to the Week 278, 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 July 21, 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: Sort String

You are given a shuffle string, $str.

Write a script to return the sorted string.

A string is shuffled by appending word position to each word.

Example 1

Input: $str = "and2 Raku3 cousins5 Perl1 are4"
Output: "Perl and Raku are cousins"

Example 2

Input: $str = "guest6 Python1 most4 the3 popular5 is2 language7"
Output: "Python is the most popular guest language"

Example 3

Input: $str = "Challenge3 The1 Weekly2"
Output: "The Weekly Challenge"

There are a number of ways this could go wrong with faulty input. We will not try to validate the input, and we will assume correct input.

Sort String in Raku

We first split the input string into space-separated words, using the words method. We then use a regex to capture separately the letters and the digits, and store the letters in the @positions array, at the index given by the digit part.

sub sort-string ($in) {
    my @positions;
    for $in.words -> $word {
        $word ~~ m/(\D+)(\d+)/;
        @positions[$/[1]] = ~$/[0];

    }
    return "@positions[1..@positions.end]";
}
my @tests = "and2 Raku3 cousins5 Perl1 are4", 
            "guest6 Python1 most4 the3 popular5 is2 language7",
            "Challenge3 The1 Weekly2";
for @tests -> $test {
    say $test;
    say sort-string $test;
    say "";
}

This program displays the following output:

$ raku ./sort-sting.raku
and2 Raku3 cousins5 Perl1 are4
Perl and Raku are cousins

guest6 Python1 most4 the3 popular5 is2 language7
Python is the most popular guest language

Challenge3 The1 Weekly2
The Weekly Challenge

Sort String in Perl

This is a port to Perl of the above Raku program. Here, the words are separated using the split built-in function. Then, we use regular expression captures to retrieve the alphabetical part and the numeric part, which are then stored into the @positions array.

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

sub sort_string {
    my @positions;
    my @words = split /\s+/, shift;
    for my $word (@words) {
        my ($letters, $digits) = ($word =~ m/(\D+)(\d+)/);
        $positions[$digits] = $letters;

    }
    return "@positions[1..$#positions]";
}
my @tests = ("and2 Raku3 cousins5 Perl1 are4", 
            "guest6 Python1 most4 the3 popular5 is2 language7",
            "Challenge3 The1 Weekly2");
for my $test (@tests) {
    say $test;
    say sort_string $test;
    say "";
}

This program displays the following output:

$ perl  ./sort-sting.pl
and2 Raku3 cousins5 Perl1 are4
Perl and Raku are cousins

guest6 Python1 most4 the3 popular5 is2 language7
Python is the most popular guest language

Challenge3 The1 Weekly2
The Weekly Challenge

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

These are some answers to the Week 277, 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 July 14, 2024, known in France as Bastille Day, 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: Strong Pair

You are given an array of integers, @ints.

Write a script to return the count of all strong pairs in the given array.

A pair of integers x and y is called strong pair if it satisfies: 0 < |x - y| < min(x, y).

Example 1

Input: @ints = (1, 2, 3, 4, 5)
Ouput: 4

Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)

Example 2

Input: @ints = (5, 7, 1, 7)
Ouput: 1

Strong Pairs: (5, 7)

We have a slight problem with example 2: since the integer 7 appears twice in the input array, we will find twice the strong pair (5, 7) and the output will be 2, not 1. To solve this issue and obtain the result specified in the example, we will remove duplicates from the input array before we start building the pairs.

Strong Pair in Raku

First, we use the unique method to remove duplicates from the input array, then we use the combinations method to generate all possible pairs. We increment the $count counter for each pair matching the strong pair criteria, and finally return the counter.

sub strong-pairs (@in) {
    my` $count = 0;
    for @in.unique.combinations: 2 -> @pair {
        $count++ if 0 < (@pair[0] - @pair[1]).abs < @pair.min;
    }
    return $count;
}

my @tests = (1, 2, 3, 4, 5), (5, 7, 1, 7);
for @tests -> @test {
    printf "%-10s => ", "@test[]";
    say strong-pairs @test;
}

This program displays the following output:

$ raku ./strong-pairs.raku
1 2 3 4 5  => 4
5 7 1 7    => 1

Strong Pair in Perl

This is essentially a port to Perl of the above Raku program. In Perl, the canonical way to remove duplicates is to coerce the input list into a hash and then retrieve the keys of the hash. Then we use two nested for loops to generate all the possible pairs. Next, we increment the $count counter for each pair matching the strong pair criteria, and finally return the counter.

sub strong_pairs {
    my %input = map { $_ => 1 } @_; # remove duplicates
    my @in = keys %input;
    my $count = 0;
    for my $i (0..$#in) {
        for my $j ($i+1..$#in) {
            my $min = $in[$i] < $in[$j] ? $i : $j;
            $count++ if 0 < abs($in[$i] - $in[$j]) and
                abs($in[$i] - $in[$j]) < $in[$min];
        }
    }
    return $count;
}

my @tests = ([1, 2, 3, 4, 5], [5, 7, 1, 7]);
for my $test (@tests) {
    printf "%-10s => ", "@$test";
    say strong_pairs @$test;
}

This program displays the following output:

$ perl ./strong-pairs.pl
1 2 3 4 5  => 4
5 7 1 7    => 1

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