laurent_r

These are some answers to the Week 265, 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 April 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: Completing Word

You are given a string, $str containing alphanumeric characters and array of strings (alphabetic characters only), @str.

Write a script to find the shortest completing word. If none found return empty string.

A completing word is a word that contains all the letters in the given string, ignoring space and number. If a letter appeared more than once in the given string then it must appear the same number or more in the word.

Example 1

Input: $str = 'aBc 11c'
       @str = ('accbbb', 'abc', 'abbc')
Output: 'accbbb'

The given string contains following, ignoring case and number:
a 1 times
b 1 times
c 2 times

The only string in the given array that satisfies the condition is 'accbbb'.

Example 2

Input: $str = 'Da2 abc'
       @str = ('abcm', 'baacd', 'abaadc')
Output: 'baacd'

The given string contains following, ignoring case and number:
a 2 times
b 1 times
c 1 times
d 1 times

The are 2 strings in the given array that satisfies the condition:
'baacd' and 'abaadc'.

Shortest of the two is 'baacd'

Example 3

Input: $str = 'JB 007'
       @str = ('jj', 'bb', 'bjb')
Output: 'bjb'

The given string contains following, ignoring case and number:
j 1 times
b 1 times

The only string in the given array that satisfies the condition is 'bjb'.

The task specification does not state it explicitly, but the examples show that we should ignore case when comparing letters.

Completing Word in Raku

In Raku, we'll use a Bag, which is a collection of distinct elements that each have an integer weight assigned to them signifying how many copies of that element are considered "in the bag", to store a histogram of the letter frequencies, both for the input test string and the words to which it should be compared. The good thing about it is that we obtain directly a histogram of the input letter list, and that can use the ⊆ Subset of or equal to operator,infix%E2%8A%86) to check directly the completing condition.

sub complete-word  ($in-str, @in-words) {
    my $letters = $in-str.comb.map({ .lc}).grep( /<[a..z]>/).Bag;
    my @result;
    for @in-words -> $word {
        push @result, $word if $letters ⊆ $word.comb.map({ .lc }).Bag;
    }
    return min(@result, :by( { $_.chars } )); 
}

my @tests = ('aBc 11c', ('accbbb', 'abc', 'abbc')),
            ('Da2 abc', ('abcm', 'baacd', 'abaadc')),
            ('JB 007', ('jj', 'bb', 'bjb'));
for @tests -> @test {
    printf "%-8s - %-20s => ", @test[0], "@test[1]";
    say complete-word @test[0], @test[1];
}

This program displays the following output:

$ raku ./complete-wortd.raku
aBc 11c  - accbbb abc abbc      => accbbb
Da2 abc  - abcm baacd abaadc    => baacd
JB 007   - jj bb bjb            => bjb

Completing Word in Perl

This is a port to Perl of the above Raku program. We use a hash instead of a Bag to store the histogram of the input letters. The use of the subset operator is replaced by a simple loop to find out whether any letter of the input test string is missing (or in smaller number) in the input words.

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

sub complete_word {
    my ($in_str, @in_words) = @_;
    my %letters;
    $letters{$_}++ for grep { $_ =~ /[a-z]/ } map { lc } split //, $in_str;
    my @result;
    WORD: for my $word (@in_words) {
        my %word_let;
        $word_let{$_}++ for map { lc } split //, $word;
        for my $k (keys %letters) {
            next WORD unless exists $word_let{$k};
            next WORD if $letters{$k} > $word_let{$k};
        }   
        push @result, $word;
    }
    return (sort {length $a <=> length $b} @result)[0];
}

my @tests = ( ['aBc 11c', ['accbbb', 'abc', 'abbc']],
              ['Da2 abc', ['abcm', 'baacd', 'abaadc']],
              ['JB 007', ['jj', 'bb', 'bjb']]  );
for my $test (@tests) {
    printf "%-8s - %-10s => ", $test->[0], "$test->[1][0] ...";
    say complete_word $test->[0], @{$test->[1]};
}

This program displays the following output:

$ perl ./complete-wortd.pl
aBc 11c  - accbbb ... => accbbb
Da2 abc  - abcm ...   => baacd
JB 007   - jj ...     => bjb

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

These are some answers to the Week 265, 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 April 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: 33% Appearance

You are given an array of integers, @ints.

Write a script to find an integer in the given array that appeared 33% or more. If more than one found, return the smallest. If none found then return undef.

Example 1

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

1 appeared 1 times.
2 appeared 2 times.
3 appeared 4 times.

3 appeared 50% (>33%) in the given array.

Example 2

Input: @ints = (1,1)
Output: 1

1 appeared 2 times.

1 appeared 100% (>33%) in the given array.

Example 3

Input: @ints = (1,2,3)
Output: 1

1 appeared 1 times.
2 appeared 1 times.
3 appeared 1 times.

Since all three appeared 33.3% (>33%) in the given array.
We pick the smallest of all.

33% Appearance in Raku

We coerce the input array into a Bag, which is a collection of distinct elements that each have an integer weight assigned to them, signifying how many copies of that element are considered "in the bag". The good thing about it is that we obtain directly a histogram of the values in the input array. Note that we return Nil rather than undef when no solution because this is more in line with what Raku does in such cases.

sub thirty-three-pct (@in) {
    my $count = @in.elems;
    return Nil if $count == 0;
    my $limit = $count * .33;
    my $histo = @in.Bag;
    my @eligibles = grep { $histo{$_} > $limit }, $histo.keys;
    return @eligibles ?? @eligibles.min !! Nil;
}

my @tests = <1 2 3 3 3 3 4 2>, <1 2>, <1 2 3>, 
            <1 2 1 2 1 2 1 2>, <1 2 3 4 1 2 3 4>;
for @tests -> @test {
    printf "%-18s => ", "@test[]";
    say thirty-three-pct @test;
}

This program displays the following output:

$ raku ./33-pct.raku
1 2 3 3 3 3 4 2    => 3
1 2                => 1
1 2 3              => 1
1 2 1 2 1 2 1 2    => 1
1 2 3 4 1 2 3 4    => Nil

33% Appearance in Perl

This is a port to Perl of the above Raku program. We use a hash instead of a Bag to store the histogram of the input values.

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

sub thirty_three_pct {
    my $count = scalar @_;
    return "Undef" if $count == 0;
    my $limit = $count * .33;
    my %histo;
    $histo{$_}++ for @_;
    my @eligibles = sort {$a <=> $b} 
                    grep { $histo{$_} > $limit } keys %histo;
    return @eligibles ? $eligibles[0] : "Undef";
}

my @tests = ([<1 2 3 3 3 3 4 2>], [<1 2>], [<1 2 3>],
             [<1 2 1 2 1 2 1 2>], [<1 2 3 4 1 2 3 4>]);
for my $test (@tests) {
    printf "%-18s => ", "@$test";
    say thirty_three_pct @$test;
}

This program displays the following output:

$ perl ./33-pct.pl
1 2 3 3 3 3 4 2    => 3
1 2                => 1
1 2 3              => 1
1 2 1 2 1 2 1 2    => 1
1 2 3 4 1 2 3 4    => Undef

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

These are some answers to the Week 264, 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 April 14, 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: Target Array

You are given two arrays of integers, @source and @indices. The @indices can only contains integers 0 <= i < size of @source.

Write a script to create target array by insert at index $indices[i] the value $source[i].

Example 1

Input: @source  = (0, 1, 2, 3, 4)
       @indices = (0, 1, 2, 2, 1)
Output: (0, 4, 1, 3, 2)

@source  @indices  @target
0        0         (0)
1        1         (0, 1)
2        2         (0, 1, 2)
3        2         (0, 1, 3, 2)
4        1         (0, 4, 1, 3, 2)

Example 2

Input: @source  = (1, 2, 3, 4, 0)
       @indices = (0, 1, 2, 3, 0)
Output: (0, 1, 2, 3, 4)

@source  @indices  @target
1        0         (1)
2        1         (1, 2)
3        2         (1, 2, 3)
4        3         (1, 2, 3, 4)
0        0         (0, 1, 2, 3, 4)

Example 3

Input: @source  = (1)
       @indices = (0)
Output: (1)

The way the target array is constructed (as detailed in the examples) is somewhat weird, so that we cannot use array slices as I was originally hoping. We have to build the target array iteratively, item by item.

Also note that we are not told what to do if the @source and @indices arrays don't have the same size, so we will assume they have the same size.

Target Array in Raku

In order to built the target array in accordance with the rules explained in the examples, the easiest is to use the splice routine, which can add, remove or replace elements of an array. In this specific case, we don't remove or replace items of the array (this is why the third parameter of the splice function call is set to 0), but just add one value at a time.

sub target-array (@source, @indices) {
    my @target;
    for 0..@source.end -> $i {
        splice @target, @indices[$i], 0,  @source[$i];
    }
    return @target;
}

my @tests = ( (0, 1, 2, 3, 4), (0, 1, 2, 2, 1) ),
            ( (1, 2, 3, 4, 0), (0, 1, 2, 3, 0) ),
            ( (1,), (0,) );
for @tests -> @test {
    printf "%-10s - %-10s => ", "@test[0]", "@test[1]";
    say target-array @test[0], @test[1];
}

This program displays the following output:

$ raku ./target-array.raku
0 1 2 3 4  - 0 1 2 2 1  => [0 4 1 3 2]
1 2 3 4 0  - 0 1 2 3 0  => [0 1 2 3 4]
1          - 0          => [1]

Target Array in Perl

This is a port to Perl of the above Raku program. For our practical purpose, Perl's splice function behaves essentially the same way as Raku's splice routine.

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

sub target_array  {
    my @source = @{$_[0]};
    my @indices = @{$_[1]};
    my @target;
    for my $i (0..$#source) {
        splice @target, $indices[$i], 0,  $source[$i];
    }
    return @target;
}

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

This program displays the following output:

$ perl ./target-array.pl
0 1 2 3 4  - 0 1 2 2 1  => 0 4 1 3 2
1 2 3 4 0  - 0 1 2 3 0  => 0 1 2 3 4
1          - 0          => 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 April 21, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 264, 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 April 14, 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: Greatest English Letter

You are given a string, $str, made up of only alphabetic characters [a..zA..Z].

Write a script to return the greatest english letter in the given string.

A letter is greatest if it occurs as lower and upper case. Also letter ‘b’ is greater than ‘a’ if ‘b’ appears after ‘a’ in the English alphabet.

Example 1

Input: $str = 'PeRlwEeKLy'
Output: L

There are two letters E and L that appears as lower and upper.
The letter L appears after E, so the L is the greatest english letter.

Example 2

Input: $str = 'ChaLlenge'
Output: L

Example 3

Input: $str = 'The'
Output: ''

Greatest English Letter in Raku

I first thought about a regex that could, for example, detect any pair of lowercase / uppercase letter, or vice versa. This turned out to be quite inconvenient.

So I went for a completely different approach: make two lists: one with uppercase letters and one with lowercase letters, except that we store the string’s lower case letters converted as upper case letters. Then we simply look for letters that are common to the two lists (and finally sort them appropriately).

In Raku, we will store the lists in Sets, which are immutable collections of distinct elements in no particular order. One advantage of using a Set is that this removes any duplicate from each list. The second advantage is that we can use the ∩ set intersection operator to find letters that are in both lists.

One final note: we use the (Unicode) predefined character classes <:Lu> and <:Ll> to distinguish uppercase from lowercase characters.

sub greatest-eng-let ($in) {
    my $uc = (grep { / <:Lu> / }, $in.comb).Set;
    my $lc = (map { .uc }, grep {/ <:Ll> /}, $in.comb).Set;
    return  ($uc ∩ $lc).keys.sort.tail // "''"; 
}

my @tests = < PeRlwEeKLy ChaLlenge The >;
for @tests -> $test {
    printf "%-15s => ", $test;
    say greatest-eng-let $test;
}

This program displays the following output:

$ raku ./greatest-eng-let.raku
PeRlwEeKLy      => L
ChaLlenge       => L
The             => ''

Greatest English Letter in Perl

Our Perl implementation essentially follows the same approach as the Raku program above: make two lists: one with uppercase letters and one with lowercase letters, except that we store the string’s lower case letters converted as upper case letters. Then we simply look for letters that are common to the two lists (and finally sort them appropriately).

In Perl, our two lists will be stored in hashes. Hashes, as Raku’s Sets, remove duplicates. There is no set intersection operator, but it is quite easy to use a loop or a grep to find common items.

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

sub greatest_eng_let {
    my @in = split //, shift;
    my %uc = map { $_ => 1 } grep { $_ le 'Z' } @in; 
    my @common =  grep { exists $uc{$_}}
                 map { uc } grep {$_ gt 'Z'} @in;
    return (sort @common)[-1] // "''"; 
}

my @tests = qw < PeRlwEeKLy ChaLlenge The >;
for my $test (@tests) {
    printf "%-15s => ", $test;
    say greatest_eng_let $test;
}

This program displays the following output:

$ perl ./greatest-eng-let.pl
PeRlwEeKLy      => L
ChaLlenge       => L
The             => ''

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

These are some answers to the Week 263, 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 April 7, 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: Merge Items

You are given two 2-D array of positive integers, $items1 and $items2 where element is pair of (item_id, item_quantity).

Write a script to return the merged items.

Example 1

Input: $items1 = [ [1,1], [2,1], [3,2] ]
       $items2 = [ [2,2], [1,3] ]
Output: [ [1,4], [2,3], [3,2] ]

Item id (1) appears 2 times: [1,1] and [1,3]. Merged item now (1,4)
Item id (2) appears 2 times: [2,1] and [2,2]. Merged item now (2,3)
Item id (3) appears 1 time: [3,2]

Example 2

Input: $items1 = [ [1,2], [2,3], [1,3], [3,2] ]
       $items2 = [ [3,1], [1,3] ]
Output: [ [1,8], [2,3], [3,3] ]

Example 3

Input: $items1 = [ [1,1], [2,2], [3,3] ]
       $items2 = [ [2,3], [2,4] ]
Output: [ [1,1], [2,9], [3,3] ]

Merge Items in Raku

We iterate over the items of the two arrays and store in a hash (%total) the quantities. At the end, we reorganize the hash into two 2-D arrays of positive integers (to retrieve the input data format).

sub merge-items (@in1, @in2) {
    my %total;
    for (|@in1, |@in2) -> @items {
        %total{@items[0]} += @items[1];
    }
    return map { ($_, %total{$_} ) }, %total.keys.sort;
}

my @tests = ( ((1,1), (2,1), (3,2)), ((2,2), (1,3)) ),
            ( ((1,2), (2,3), (1,3), (3,2)), ((3,1), (1,3)) ),
            ( ((1,1), (2,2), (3,3)), ((2,3), (2,4)) );
for @tests -> @test {
    printf "%-15s - %-10s => ", "@test[0]", "@test[1]";
    say merge-items @test[0], @test[1];
}

This program displays the following output:

$ raku ./merge-items.raku
1 1 2 1 3 2     - 2 2 1 3    => ((1 4) (2 3) (3 2))
1 2 2 3 1 3 3 2 - 3 1 1 3    => ((1 8) (2 3) (3 3))
1 1 2 2 3 3     - 2 3 2 4    => ((1 1) (2 9) (3 3))

Merge Items in Perl

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

sub merge_items {
    my %total;
    for my $in (@_) {
        for my $items (@$in) {
            $total{$items->[0]} += $items->[1];
        }
    }
    return map { "[ $_  $total{$_} ] " } sort keys %total;
}

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

Note that, when printing the input test data, the program displays only the first item (the first pair) of each test.

This program displays the following output:

$ perl ./merge-items.pl
[1  1] ... => [ 1  4 ] [ 2  3 ] [ 3  2 ]
[1  2] ... => [ 1  8 ] [ 2  3 ] [ 3  3 ]
[1  1] ... => [ 1  1 ] [ 2  9 ] [ 3  3 ]

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