laurent_r

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.