laurent_r

These are some answers to the Week 292, 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 October 27, 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: Twice Largest

You are given an array of integers, @ints, where the largest integer is unique.

Write a script to find whether the largest element in the array is at least twice as big as every element in the given array. If it is return the index of the largest element or return -1 otherwise.

Example 1

Input: @ints = (2, 4, 1, 0)
Output: 1

The largest integer is 4.
For every other elements in the given array is at least twice as big.
The index value of 4 is 1.

Example 2

Input: @ints = (1, 2, 3, 4)
Output: -1

The largest integer is 4.
4 is less than twice the value of 3, so we return -1.

My first comment is that we don't really know what to do with negative integers, especially if all input values are negative. We will assume that exactly the same rules apply for negative values (an array with only negative values will always qualify because when you double a negative value, it becomes smaller, not larger), or that the input array will contain only non-negative values.

There is no other solution than to check (even if implicitly, say with a sort) each number of the input array. The only very slight difficulty is that we should not compare the greatest number in the input array with twice its value, because it would always fail (except if the greatest integer is 0, but that's an edge case).

Twice Largest in Raku

Once we have integrated the considerations in the previous section (please read them if you didn't), the solution is straight forward. I was initially hoping to use a junction, probably an any or none junction, but the fact that we need to exclude the largest item from the comparison makes it slightly more complicated and less efficient (since we would have to visit each input value once more). So, I used a simple loop. Thinking again about it afterward, I came to the conclusion that using a one junction might have avoided the need for an extra loop: if there is one (and only one) value whose double is larger than the greatest integer, then our input array almost certainly satisfies the task's conditions (at least with positive input values). Testing that alternate solution is left as an exercise for the reader.

sub twice-larger (@in) {d for an extra loop. 
    my ($max-i, $largest) = @in.max(:kv);
    for @in -> $i {
        next if $i == $largest;
        return -1 if 2 * $i > $largest;
    }
    return $max-i;
}
for (2, 4, 1, 0), (1, 2, 3, 4), (4, 3, 5, 12, 2) -> @test {
    printf "%-12s => ", "@test[]";
    say twice-larger @test;
}

This program displays the following output:

$ raku ./twice-largest.raku
2 4 1 0      => 1
1 2 3 4      => -1
4 3 5 12 2   => 3

Twice Largest in Perl

This program is essentially a port to Perl of the above Raku program. Please refer to the previous sections if you need explanations. Since Perl doesn't have junctions, we need to use a loop over the input values, just as we did in Raku. Note that we had to implement a max auxiliary subroutine, since there is no built-in function to do that (which is no problem, as it is very simple and worked fine straight out of the box).

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

sub max {
    my $max = shift;
    for (@_) {
        $max = $_ if $_ > $max;
    }
    return $max;
}

sub twice_larger {
    my $largest = max @_;
    my $max_i;
    for my $i (0..$#_){
        my $val = $_[$i];
        if ($val == $largest) {
            $max_i = $i;
            next;
        }
        return -1 if 2 * $val > $largest;
    }
    return $max_i;
}
for my $test ([2, 4, 1, 0], [1, 2, 3, 4], [4, 3, 5, 12, 2]) {
    printf "%-12s => ", "@$test";
    say twice_larger @$test;
}

This program displays the following output:

$ perl ./twice-largest.pl
2 4 1 0      => 1
1 2 3 4      => -1
4 3 5 12 2   => 3

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