laurent_r

These are some answers to the Week 189 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 November, 6, 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: Greater Character

You are given an array of characters (a..z) and a target character.

Write a script to find out the smallest character in the given array lexicographically greater than the target character.

Example 1

Input: @array = qw/e m u g/, $target = 'b'
Output: e

Example 2

Input: @array = qw/d c e f/, $target = 'a'
Output: c

Example 3

Input: @array = qw/j a r/, $target = 'o'
Output: r

Example 4

Input: @array = qw/d c a f/, $target = 'a'
Output: c

Example 5

Input: @array = qw/t g a l/, $target = 'v'
Output: v

Note that when the array has no item larger than the target value, the behavior is undefined. I do not think that the solution provided for the example 5 is valid. I prefer to state clearly that no solution was found.

Greater Character in Raku

The greater-char subroutine uses grep to build the list of characters lexicographically greater than the target value and returns the smallest one. The ability to use two (or more) loop variables ($k and @test) in a for pointy block is very practical here.

sub greater-char ($target, @input) {
    return @input.grep({ $_ gt $target }).min;
}
for ('b', <e m u g>), ('a', <d c e f>), ('o', <j a r>),
    ('a', <d c a f>), ('v', <t g a l>)  ->  ($k, @test) {
    say "$k, (@test[]) \t -> ", greater-char($k, @test);
}

This program displays the following output:

$ raku ./greater-char.raku
b, (e m u g)     -> e
a, (d c e f)     -> c
o, (j a r)       -> r
a, (d c a f)     -> c
v, (t g a l)     -> Nil

Greater Character in Perl

The greater_char subroutine uses grep to build the list of characters lexicographically greater than the target value and returns the smallest one. Here, we lazily use sort to find the smallest character of the list; this is not the best algorithmic method (and it might not be good for very long lists of characters), but it is the fastest to develop. Saving development time is sometimes better than saving a few CPU cycles.

In the event that the character lists were significantly longer, we could use a min subroutine such as this one developed for a previous Perl Weekly Challenge task:

sub min {
    my $min = shift;
    for (@_) {
        $min = $_ if $_ lt $min;
    }
    return $min;
}

But this is not really needed here, so we use the built-in sort function.

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

sub greater_char  {
    my @eligible_input = grep { $_ gt $_[0]} @{$_[1]};
    return (sort @eligible_input)[0];
}

for my $test (['b', [<e m u g>]], ['a', [<d c e f>]], 
    ['o', [<j a r>]], ['a', [<d c a f>]], ['v', [<t g a l>]]) {
    say "$test->[0] (@{$test->[1]}) \t -> ", greater_char($test->[0], $test->[1]);
}

This program displays the following output:

$ perl greater-char.pl
b (e m u g)      -> e
a (d c e f)      -> c
o (j a r)        -> r
a (d c a f)      -> c
v (t g a l)      ->

Task 2: Array Degree

You are given an array of 2 or more non-negative integers.

Write a script to find out the smallest slice, i.e. contiguous subarray of the original array, having the degree of the given array.

> The degree of an array is the maximum frequency of an element in the array.

Example 1

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

The degree of the given array is 2.
The possible subarrays having the degree 2 are as below:
(3, 3)
(1, 3, 3)
(3, 3, 2)
(1, 3, 3, 2)

And the smallest of all is (3, 3).

Example 2

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

Example 3

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

Example 4

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

Example 5

Input: @array = (2, 1, 2, 1, 1)
Output: (1, 2, 1, 1)

The definition of the degree of an array doesn’t state what the degree should be when more than one element reaches the maximum frequency. In my implementations, I have changed examples 3 and 4 of the task specification to avoid the problem.

Array Degree in Raku

The get-degree subroutine builds an %histogram hash of input integers with their frequency, and returns the histogram key having the highest value. Then, the main part of the program uses twice the built-in first routine to find the first and last occurrences of the computed degree in the input list.

sub get-degree (@input) {
    my %histogram;
    %histogram{$_}++ for @input;
    return (%histogram.max({$_.value})).key;
}

for <1 3 3 2>, <1 2 1 3>, <4 3 2 1 2> ,
    <1 1 2 3 4>, <2 1 2 1 1> -> @test {
    my $degree = get-degree(@test);
    my $start = @test.first: * == $degree, :k;
    my $end =   @test.first: * == $degree, :k :end;
    say "@test[] \t => @test[$start..$end]";
}

This program displays the following output:

$ raku ./array-degree.raku
1 3 3 2          => 3 3
1 2 1 3          => 1 2 1
4 3 2 1 2        => 2 1 2
1 1 2 3 4        => 1 1
2 1 2 1 1        => 1 2 1 1

Array Degree in Perl

The get_degree subroutine builds an histogram of input integers with their frequency, and returns the histogram key having the highest value. Note that, here again, we lazily use the built-in sort function to find the largest value. Please see my comment in the Greater Character in Perl section above about algorithmically better solutions. In the main part of the program, we just loop once over the list to find the first and last occurrences of the degree in the input list.

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

sub get_degree {
    my %histo;  # histogram
    $histo{$_}++ for @_;
    return (sort { $histo{$b} <=> $histo{$a} } keys %histo)[0]
}

for my $test ([<1 3 3 2>], [<1 2 1 3>], 
    [<4 3 2 1 2>], [<1 1 2 3 4>], [<2 1 2 1 1>]) {
    my @list = @$test;
    my $degree = get_degree @list;
    my ($start, $end);
    for my $i (0..$#list) {
        if ($list[$i] == $degree) {
            $start = $i unless defined $start;
            $end = $i;
        }
    }
    say "@list \t => @list[$start..$end]";
}

This program displays the following output:

$ perl ./array-degree.pl
1 3 3 2          => 3 3
1 2 1 3          => 1 2 1
4 3 2 1 2        => 2 1 2
1 1 2 3 4        => 1 1
2 1 2 1 1        => 1 2 1 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 November 13, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.