laurent_r

These are some answers to the Week 277, 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 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 1: Count Common

You are given two arrays of strings, @words1 and @words2.

Write a script to return the count of words that appears in both arrays exactly once.

Example 1

Input: @words1 = ("Perl", "is", "my", "friend")
       @words2 = ("Perl", "and", "Raku", "are", "friend")
Output: 2

The words "Perl" and "friend" appear once in each array.

Example 2

Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
       @words2 = ("Python", "is", "top", "in", "guest", "languages")
Output: 1

Example 3

Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
       @words2 = ("Crystal", "is", "similar", "to", "Ruby")
Output: 0

Count Common in Raku

We could probably suggest a more concise solution by chaining the operations in a pipeline, but I preferred not to do so to improve readability.

First, we find the word frequencies by coercing the input arrays into Bags. Then, we keep items that appear only once and filter out the others. Finally, we use ∩,infix%E2%88%A9) intersection operator between the two unique bags and return the number of items in the intersection Set.

sub count-common (@in1, @in2) {
    my $bag-in1 = @in1.Bag;
    my $bag-in2 = @in2.Bag;
    my $unique1 = grep {$bag-in1{$_} == 1}, $bag-in1.keys;  .
    my $unique2 = grep {$bag-in2{$_} == 1}, $bag-in2.keys;
    return ($unique1 ∩ $unique2).elems;
}

my @tests = ( <Perl is my friend>, 
              <Perl and Raku are friend> ),
            ( <Perl is my friend>, 
              <Raku is friend of my friend Perl> ),
            ( <Perl and Python are very similar>, 
              <Python is top in guest languages> ),
            ( <Perl is imperative Lisp is functional>, 
              <Crystal is similar to Ruby> );

for @tests -> @test {
    say @test[0];
    say @test[1];
    say count-common @test[0], @test[1];
    say "";
}

This program displays the following output:

$ raku ./count-common.raku
(Perl is my friend)
(Perl and Raku are friend)
2

(Perl is my friend)
(Raku is friend of my friend Perl)
3

(Perl and Python are very similar)
(Python is top in guest languages)
1

(Perl is imperative Lisp is functional)
(Crystal is similar to Ruby)
0

Count Common in Perl

This is a port to Perl of the above Raku program. However, since there are no Bags in Perl, we use hashes to the same effect and have to populate them manually in a for loop. Similarly, we replace the intersection operator by another for loop.

use warnings;
use feature 'say';
use Data::Dumper;

sub count_common {
    my (%in1, %in2);
    for my $word (@{$_[0]}) {
        $in1{$word}++;
    }
    for my $word (@{$_[1]}) {
        $in2{$word}++;
    }
    my %unique1 = map { $_ => 1 } grep {$in1{$_} == 1} keys %in1;
    my %unique2 = map { $_ => 1 } grep {$in2{$_} == 1} keys %in2;
    my @intersect;
    for my $word (keys %unique1) {
        push @intersect, $word if exists $unique2{$word};
    }
    return scalar @intersect;  
}
my @tests = ( [ [<Perl is my friend>], 
               [<Perl and Raku are friend>] ],
             [ [<Perl is my friend>],
               [<Raku is friend of my friend Perl>] ],
             [ [<Perl and Python are very similar>],
               [<Python is top in guest languages>] ],
             [ [<Perl is imperative Lisp is functional>],
               [<Crystal is similar to Ruby>] ]
           );
for my $test (@tests) {
    say  "@{$test->[0]}";
    say  "@{$test->[1]}";
    say count_common $test->[0], $test->[1];
    say "";
}

This program displays the following output:

$ perl  ./count-common.pl
Perl is my friend
Perl and Raku are friend
2

Perl is my friend
Raku is friend of my friend Perl
3

Perl and Python are very similar
Python is top in guest languages
1

Perl is imperative Lisp is functional
Crystal is similar to Ruby
0

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.