laurent_r

These are some answers to the Week 191 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, 20, 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: Twice Largest

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.

Example 1

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

The largest in the given list is 4. However 4 is not greater than twice of every remaining elements.
1 x 2 < 4
2 x 2 > 4
2 x 3 > 4

Example 2

Input: @list = (1,2,0,5)
Output: 1

The largest in the given list is 5. Also 5 is greater than twice of every remaining elements.
1 x 2 < 5
2 x 2 < 5
0 x 2 < 5

Example 3

Input: @list = (2,6,3,1)
Output: 1

The largest in the given list is 6. Also 6 is greater than twice of every remaining elements.
2 x 2 < 6
3 x 2 < 6
1 x 2 < 6

Example 4

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

The largest in the given list is 5. Also 5 is not greater than twice of every remaining elements.
4 x 2 > 5
2 x 2 < 5
3 x 2 > 5

Our task is to find out whether the largest item in the list is at least twice as large as each of the other items. This is not the same thing as twice larger, which may be construed to mean larger than twice each other item. In other words, we need to use >=, not >. For example, in example 1, we have:

2 x 2 > 4

which is obviously wrong. Similarly, in example 3, 3 x 2 < 6 is also wrong. The required output provided with the examples is in line with this understanding, in spite of the somewhat erroneous notation in the explanations.

Twice Largest in Raku

We only need to compare the largest item with twice the second largest item. Since the lists of integers are very small, we can just sort the item (in descending order) and work with the first two items in the list.

Note that we lazily use sort to find the two largest items of the list; as already discusses in PWC 189 and elsewhere, this is not the best algorithmic method (and it might not be good for very long lists), but it is the fastest to develop. Saving development time is sometimes more important than saving a few CPU cycles. The resulting code is fairly concise and very easy to understand.

sub is-twice-as-large (@input) {
    my @sorted = reverse sort @input;
    return @sorted[0] >= 2 * @sorted[1];
}
for <1 2 3 4>, <1 2 0 5>, <2 6 3 1>, <4 5 2 3> -> @test {
    say @test, " -> ", is-twice-as-large(@test) ?? 1 !! -1;
}

This script displays the following output:

$ raku ./twice.raku
(1 2 3 4) -> -1
(1 2 0 5) -> 1
(2 6 3 1) -> 1
(4 5 2 3) -> -1

Twice Largest in Perl

This is a port to Perl of the Raku program above. The explanations and comments made above also apply here.

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

sub is_twice_as_large {
    my @sorted = sort { $b <=> $a } @_;
    return $sorted[0] >= 2 * $sorted[1];
}
for my $test ( [<1 2 3 4>], [<1 2 0 5>], 
               [<2 6 3 1>], [<4 5 2 3>] ) {
    say "@$test -> ", is_twice_as_large(@$test) ? 1 : -1;
}

This script displays the following output:

$ perl twice.pl
1 2 3 4 -> -1
1 2 0 5 -> 1
2 6 3 1 -> 1
4 5 2 3 -> -1

Task 2: Cute List

You are given an integer, 0 < $n <= 15.

Write a script to find the number of orderings of numbers that form a cute list.

With an input @list = (1, 2, 3, .. $n) for positive integer $n, an ordering of @list is cute if for every entry, indexed with a base of 1, either

1) $list[$i] is evenly divisible by $i or 2) $i is evenly divisible by $list[$i]

Example

Input: $n = 2
Ouput: 2

Since $n = 2, the list can be made up of two integers only i.e. 1 and 2.
Therefore we can have two list i.e. (1,2) and (2,1).

@list = (1,2) is cute since $list[1] = 1 is divisible by 1 
and $list[2] = 2 is divisible by 2.

I wish we had a non-trivial example with more items in the input list, but my understanding is as follows: for a given integer $n, we first build the list of positive integers from 1 to $n and then check every permutation of the list to verify whether it is a cute list, as defined by the two divisibility properties stated above.

Cute List in Raku

The count-cute subroutine generates all permutations of the input list and, for each permutation, calls the is-cute subroutine to figure out whether such permutation is a cute list.

For the purpose of testing, we run the count-cute subroutine for every integer between 1 and 10. We did no go further because the program is becoming very slow for even moderately large input values: the number of permutations of a list grows as the factorial of the number of its items, so that we have essentially an exponential explosion. The performance is further slowed down by the fact that checking each permutation takes longer when the permutations have more items.

sub is-cute (@list) {
    my @new = (0, @list).flat;
    for 1..@list.elems -> $i {
        return False unless $i %% @new[$i] or @new[$i] %% $i;
    }
    return True;
}

sub count-cute ($k) {
    my $count = 0;
    for (1..$k).permutations -> @perm {
        $count++ if is-cute @perm;
    }
    return $count;
}

for 1..10 -> $j {
    say "$j -> ", count-cute $j;
}

This script displays the following output and timings:

$ time raku ./cute-list.raku
1 -> 1
2 -> 2
3 -> 3
4 -> 8
5 -> 10
6 -> 36
7 -> 41
8 -> 132
9 -> 250
10 -> 700

real    0m36,083s
user    0m0,000s
sys     0m0,031s

Using the Native Calling Interface and replacing the is-cute subroutine by a C is_cute function improves the performance quite a bit, but not enough to solve or even significantly alleviate the combinatorial nightmare:

real    0m26,208s
user    0m0,000s
sys     0m0,015s

Cute List in Perl

This is essentially a port to Perl of the Raku program above. Please refer to the comments above for further information. Since Perl doesn’t have a built-in permutations routine, we build our own recursive permute subroutine. Note that the Perl implementation is about twice faster than the Raku implementation. Raku is still significantly slower than Perl, but the good news is that its performance is slowly catching up.

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

my @permutations;

sub is_cute {
    my @new = (0, @_);
    for my $i (1.. scalar @_) {
        return 0 if $i % $new[$i] and $new[$i] % $i;
    }
    return 1;
}

sub permute {
    my ($done, $left) = @_;
    if (scalar @$left == 0) {
        push @permutations, $done;
        return;
    }
    my @left = @$left;
    permute([ @$done, $left[$_]], [@left[0..$_-1], @left[$_+1..$#left]]) for 0..$#left;
}

sub count_cute {
    my $k = shift;
    my $count = 0;
    @permutations = ();
    permute([], [1..$k]);
    for my $perm (@permutations) {
        $count++ if is_cute @$perm;
    }
    return $count;
}

for my $j (1..10) {
    say "$j -> ", count_cute $j;
}

This script displays the following output and timings:

$ time perl ./cute-list.pl
1 -> 1
2 -> 2
3 -> 3
4 -> 8
5 -> 10
6 -> 36
7 -> 41
8 -> 132
9 -> 250
10 -> 700

real    0m18,773s
user    0m17,687s
sys     0m0,858s

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