laurent_r

These are some answers to the Week 229, 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 August 13, 2023 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: Two out of Three

You are given three array of integers.

Write a script to return all the elements that are present in at least 2 out of 3 given arrays.

Example 1

Input: @array1 = (1, 1, 2, 4)
       @array2 = (2, 4)
       @array3 = (4)
Ouput: (2, 4)

Example 2

Input: @array1 = (4, 1)
       @array2 = (2, 4)
       @array3 = (1, 2)
Ouput: (1, 2, 4)

One simple solution is to count the values, after having removed duplicates from the original input arrays. Then, for each value, we obtain the number of arrays in which this value appears.

Two out of Three in Raku

In Raku, we will use a BagHash to construct a total histogram of values (unique in the input arrays). Once we have that, we can simply return the items of the histogram that occur more than twice.

sub two-out-of-three (@a) {
    my $histo = BagHash.new: @a[0].unique;
    $histo.add($_) for @a[1].unique, @a[2].unique;
    return sort grep { $histo{$_} >= 2 }, $histo.keys;
}
for ( (1, 1, 2, 4), (2, 4), (4,) ), 
    ( (4, 1), (2, 4), (1, 2) ) -> @test {
    printf "%-22s => ", @test.gist;
    say two-out-of-three (@test);
}

This program displays the following output:

$ raku ./two-out-of-three.raku
((1 1 2 4) (2 4) (4))  => (2 4)
((4 1) (2 4) (1 2))    => (1 2 4)

Two out of Three in Perl

This is a port to Perl of the above Raku problem. We use a hash instead of a BagHash to store the histogram of values from the input arrays. Before that, however, we use a temporary hash (%temp) to remove duplicates from each input array.

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

sub two_out_of_three {
    my %histo;
    for my $in (@_) {
        my %temp = map {$_ => 1} @$in; # make items unique
        $histo{$_} += 1 for keys %temp;
    }
    return sort grep { $histo{$_} >= 2 } keys %histo;
}
for my $test ( [ [1, 1, 2, 4], [2, 4], [4] ], 
      [ [4, 1], [2, 4], [1, 2] ] ) {
    print "(@$_) " for @$test;
    say " => ", join " ", two_out_of_three (@$test);
}

This program displays the following output:

$ perl ./two-out-of-three.pl
(1 1 2 4) (2 4) (4)  => 2 4
(4 1) (2 4) (1 2)  => 1 2 4

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