laurent_r

These are some answers to the Week 234, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 2: Unequal Triplets

You are given an array of positive integers.

Write a script to find the number of triplets (i, j, k) that satisfies num[i] != num[j], num[j] != num[k] and num[k] != num[i].

Example 1

Input: @ints = (4, 4, 2, 4, 3)
Ouput: 3

(0, 2, 4) because 4 != 2 != 3
(1, 2, 4) because 4 != 2 != 3
(2, 3, 4) because 2 != 4 != 3

Example 2

Input: @ints = (1, 1, 1, 1, 1)
Ouput: 0

Example 3

Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
Output: 28

triplets of 1, 4, 7  = 3x2×2 = 12 combinations
triplets of 1, 4, 10 = 3×2×1 = 6  combinations
triplets of 4, 7, 10 = 2×2×1 = 4  combinations
triplets of 1, 7, 10 = 3x2x1 = 6 combinations

I frankly don't understand the examples 1 and 3.

First, there is nothing saying that the triplets should be in ascending (or any other) order. So, taking example 1, we could add for example the following triplets:

(3, 2, 4) - values 4, 2, 3 (same as triplet (0, 2, 4)
(3, 4, 2) - values 4, 3, 2
(4, 2, 1) - values 3, 2, 4
(4, 1, 2) - values 3, 4, 2
etc.

So, our solutions for the example provided will obviously differ from those given above in the task specification.

Second, we're not asked to output the triplets of indexes, but only the number of triplets. I'll further assume that (0, 2, 4) and (1, 2, 4) are not a valid pair of triplets, because they yield the same values. So we are looking for the number of valid partial permutations of 3 items among the input values. To make sure our permutations are valid, we can simply remove duplicates from the input list.

We don't need to generate the permutations, since there is a mathematical formula that tells us that the number of permutations of r items from an array of n items is computed as follows:

P(n, r) = (n!) / (n - r)!

In our case, since we are looking for triplets, this becomes:

P(n, 3) = (n!) / (n - 3)!

Unequal Triplets in Raku

Based on the above explanations, the count-unequal-triplets subroutine first creates the @unique array with the input values without duplicates, count the unique items and finally uses the math formula above to count the number of unique triplets. Note that the reduction operator together with the multiplication operator (for instance [*] 1..$n) makes it possible to compute directly the factorial of a positive integer (factorial of n in the example).

sub count-unequal-triplets (@in) {
    my @unique = @in.unique;
    my $n = @unique.elems;    # n = count of unique items
    return 0 if $n < 3;
    my $triplet-count = ([*] 2..$n) / ([*] 2..($n - 3));
}

for (4, 4, 2, 4, 3), (1, 1, 1, 1, 1), 
    (4, 7, 1, 10, 7, 4, 1, 1) -> @test {
    printf "%-20s => ", "@test[]";
    say count-unequal-triplets @test;
}

This program displays the following output:

$ raku ./unequal-triplets.raku
4 4 2 4 3            => 6
1 1 1 1 1            => 0
4 7 1 10 7 4 1 1     => 24

Unequal Triplets in Perl

This is a port to Perl of the above Raku program. Compared to the Raku version, we have to define our own fact subroutine to compute the factorial of a positive integer. Otherwise, please refer to the above sections for further explanations.

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

sub fact {
    my $in = shift;
    my $fact = 1;
    $fact *= $_ for 2..$in;
    return $fact;
}

sub count_unequal_triplets {
    my %unique = map { $_ => 1 } @_;
    my $n = scalar keys %unique;    # n = count of unique items
    return 0 if $n < 3;
    my $triplet_count = (fact $n) / (fact $n - 3);
}

for my $test ([4, 4, 2, 4, 3], [1, 1, 1, 1, 1], 
    [4, 7, 1, 10, 7, 4, 1, 1]){
    printf "%-20s => ", "@$test";
    say count_unequal_triplets @$test;
}

This program displays the following output:

$ perl ./unequal-triplets.pl
4 4 2 4 3            => 6
1 1 1 1 1            => 0
4 7 1 10 7 4 1 1     => 24

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