RabbitFarm

2022-11-20

Twice Largest Once Cute

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given list of integers, @list. Write a script to find out whether the largest item in the list is at least twice as large as each of the other items.

Solution


use v5.36;
use strict;
use warnings;

sub twice_largest{
    my(@list_integers) = @_;
    my @sorted_integers = sort {$a <=> $b} @list_integers;
    for my $i (@sorted_integers[0 .. @sorted_integers - 1]){
        unless($sorted_integers[@sorted_integers - 1] == $i){
            return -1 unless $sorted_integers[@sorted_integers - 1] >= 2 * $i; 
        }
    }
    return 1;
}

MAIN:{
    say twice_largest(1, 2, 3, 4);
    say twice_largest(1, 2, 0, 5);
    say twice_largest(2, 6, 3, 1);
    say twice_largest(4, 5, 2, 3);
}

Sample Run


$ perl perl/ch-1.pl
-1
1
1
-1

Notes

For Part 1 I at first couldn't see how to avoid a basic O(n^2) nested for loop. After I took a nap I think the best approach is what I have here:

  1. sort the list O(n log n)

  2. get the max element from the sorted list O(1)

  3. iterate over the sorted list, stop and return false if at any point an element times two is not less then max. return true if all elements (other than $max itself) pass the test. O(n)

So total worst case dominated by the sort O(n log n).

(And the nap was required because I was on an overnight camping trip with my son's Cub Scout pack the previous day and barely slept at all!)

Part 2

You are given an integer, 0 < $n <= 15. Write a script to find the number of orderings of numbers that form a cute list.

Solution


use v5.36;
use strict;
use warnings;

use Hash::MultiKey;

sub cute_list{
    my($n) = @_;
    my %cute;
    tie %cute, "Hash::MultiKey";
    for my $i (1 .. $n){
        $cute{[$i]} = undef;
    }
    my $i = 1;
    {
        $i++;
        my %cute_temp;
        tie %cute_temp, "Hash::MultiKey";
        for my $j (1 .. $n){
            for my $cute (keys %cute){
                if(0 == grep {$j == $_} @{$cute}){
                    if(0 == $j % $i || 0 == $i % $j){
                        $cute_temp{[@{$cute}, $j]} = undef;
                    }    
                }
            }
        }
        %cute = %cute_temp;
        untie %cute_temp;
        redo unless $i == $n;
    }
    return keys %cute;
}

MAIN:{
    say cute_list(2) . q//;
    say cute_list(3) . q//;
    say cute_list(5) . q//;
    say cute_list(10) . q//;
    say cute_list(11) . q//;
    say cute_list(15) . q//;
}

Sample Run


$ perl perl/ch-2.pl
2
3
10
700
750
24679

Notes

This solution with a dynamic programming style approach seems to work pretty well. cute(11) runs in less than a second (perl 5.34.0, M1 Mac Mini 2020) which is pretty good compared to some other reported run times that have been posted to social media this week.

Some may notice that the solution here bears a striking resemblance to the one for TWC 117! The logic there was a bit more complicated, since multiple paths could be chosen. The overall idea is the same though: as we grow the possible lists we are able to branch and create new lists (paths).

References

Challenge 191

posted at: 21:50 by: Adam Russell | path: /perl | permanent link to this entry