laurent_r

These are some answers to the Week 195 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 December 18, 2022 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 1: Special Integers

You are given a positive integer, $n > 0.

Write a script to print the count of all special integers between 1 and $n.

An integer is special when all of its digits are unique.

Example 1:

Input: $n = 15
Output: 14 as except 11 all other integers between 1 and 15 are spcial.

Example 2:

Input: $n = 35
Output: 32 as except 11, 22, 33 all others are special.

Special Integers in Raku

The is-special subroutine stores the digits into a set ($h), which has the property of removing duplicates. At the end, if the set has the same number of elements as the number of characters in the input number, then there is no duplicate: the number is special and the subroutine returns a True value. Otherwise, it returns a False value.

sub is-special ($n) {
    # return True if $n.chars == 1;
    my $h = set $n.comb;
    return $h.elems == $n.chars;
}

for 15, |(32..45), 1232, 1233, 1234 -> $m {
    my $count = $m <= 9 ?? $m !!  9;
    for 10..$m -> $i {
        $count++ if is-special $i;
    }
    say "$m \t -> $count";
}

This program displays the following output:

$ raku ./special-numbers.raku
15       -> 14
32       -> 30
33       -> 30
34       -> 31
35       -> 32
36       -> 33
37       -> 34
38       -> 35
39       -> 36
40       -> 37
41       -> 38
42       -> 39
43       -> 40
44       -> 40
45       -> 41
1232     -> 802
1233     -> 802
1234     -> 803

Note that, as we go from 32 to 33, the number of special integers remains the same, as 33 is obviously not a special number. The same behavior is observed when we reach 44 or 1233.

Special Integers in Perl

The is_special subroutine stores the digits into a hash ($h), which has the property of removing duplicates. At the end, if the hash has the same number of elements as the number of characters in the input number, then there as no duplicate: the number is special and the subroutine returns a True value. Otherwise, it returns a False value.

use strict;
use warnings;
use feature qw/say/;

sub is_special {
    my $n = shift;
    # return True if length $n == 1;
    my %h = map { $_ => 1} split //, $n;
    return scalar %h == length $n;
}

for my $m (15, 32..45, 1232, 1233, 1234) {
    my $count = $m <= 9 ? $m : 9;
    for my $i (10..$m) {
        $count++ if is_special $i;
    }
    say "$m \t -> $count";
}

This script displays the following output:

$ perl ./special-numbers.pl
15       -> 14
32       -> 30
33       -> 30
34       -> 31
35       -> 32
36       -> 33
37       -> 34
38       -> 35
39       -> 36
40       -> 37
41       -> 38
42       -> 39
43       -> 40
44       -> 40
45       -> 41
1232     -> 802
1233     -> 802
1234     -> 803

Task 2: Most Frequent Even Number

You are given a list of numbers, @list.

Write a script to find most frequent even numbers in the list. In case you get more than one even numbers then return the smallest even integer. For all other case, return -1.

Example 1

Input: @list = (1,1,2,6,2)
Output: 2 as there are only 2 even numbers 2 and 6 and of those 2 appears the most.

Example 2

Input: @list = (1,3,5,7)
Output: -1 since no even numbers found in the list

Example 3

Input: @list = (6,4,4,6,1)
Output: 4 since there are only two even numbers 4 and 6. They both appears the equal number of times, so pick the smallest.

Most Frequent Even Number in Raku

The find-frequent-int subroutine does almost all of the work (the rest is just setting the test cases and displaying the result). This subroutine first discard the odd integers and fills an histogram hash with counters for each even integer. If the histogram is empty (i.e. there is no even integer in the input list), then the subroutine returns -1. Otherwise, the sort does essentially all the work: it sorts the histogram hash in descending order of values and then (in case of a draw) in ascending order of keys. It then simply returns the first hash key, which is bound to be the highest frequency and the smallest integer when there is a frequency draw.

sub find-frequent-int (@in) {
    my %histo = map { $_ => ++%histo{$_} }, 
                grep { $_ %% 2 }, @in;
    return -1 if %histo.elems < 1;
    return ( sort { %histo{$^b} <=> %histo{$^a} 
                  || $^a <=> $^b }, 
          %histo.keys ).first;
}
for < 1 1 2 6 2>, <1 3 5 7>, <6 4 4 6 1>, < 8 4 8 6 4 6>,
    < 8 4 8 6 4 6 8>, < 6 4 8 6 4 6 8> -> @test {
    say @test, " => ", find-frequent-int @test;
}

This script displays the following output:

$ raku ./frequent-even.raku
(1 1 2 6 2) => 2
(1 3 5 7) => -1
(6 4 4 6 1) => 4
(8 4 8 6 4 6) => 4
(8 4 8 6 4 6 8) => 8
(6 4 8 6 4 6 8) => 6

Most Frequent Even Number in Perl

This is essentially a port to Perl of the above Raku program. The find_frequent_int subroutine does almost all of the work (the rest is just setting the test cases and displaying the result). This subroutine first discard the odd integers and fills an histogram hash with counters for each even integer. If the histogram is empty (i.e. there is no even integer in the input list), then the subroutine returns -1. Otherwise, the sort does essentially all the work: it sorts the histogram hash in descending order of values and then (in case of a draw) in ascending order of keys. It then simply returns the first hash key, which is bound to be the highest frequency and the smallest integer when there is a frequency draw.

use strict;
use warnings;
use feature qw/say/;

sub find_frequent_int {
    my %histo;
    %histo = map { $_ => ++$histo{$_} } 
             grep { $_ % 2 == 0 } @_;
    return -1 if scalar %histo < 1;
    return ( sort { $histo{$b} <=> $histo{$a} 
                    || $a <=> $b } keys %histo)[0];
}
for my $test ([<1 1 2 6 2>], [<1 3 5 7>], [<6 4 4 6 1>], 
    [<8 4 8 6 4 6>], [<8 4 8 6 4 6 8>], [<6 4 8 6 4 6 8>]) {
    say "@$test => ", find_frequent_int @$test;
}

This script displays the following output:

$ perl frequent-even.pl
1 1 2 6 2 => 2
1 3 5 7 => -1
6 4 4 6 1 => 4
8 4 8 6 4 6 => 4
8 4 8 6 4 6 8 => 8
6 4 8 6 4 6 8 => 6

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