Task — Magical triplets

You are given a list of positive numbers, @n, having at least 3 numbers.

Write a script to find the triplets (a, b, c) from the given list that satisfies the following rules.

1. a + b > c
2. b + c > a
3. a + c > b
4. a + b + c is maximum.

In case, you end up with more than one triplets having the maximum then:

5. pick the triplet where a >= b >= c.

Examples

Example 1
    Input: @n = (1, 2, 3, 2);
    Output: (3, 2, 2)

Example 2
    Input: @n = (1, 3, 2);
    Output: ()

Example 3
    Input: @n = (1, 1, 2, 3);
    Output: ()

Example 4
    Input: @n = (2, 4, 3);
    Output: (4, 3, 2)

Analysis

My first approach to this was to use Algorithm::Combinatorics to get all the possible triplets, filter out the ones that satisfy rules 1, 2 and 3, and find which of these maximises a + b + c. In my submission that is Method 1 and it certainly works.

However, there is an easier way - my Method 2:

1. Sort the supplied list into reverse order
2. Suppose the first three items are now m, n and o.
3. If o is greater than m - n, then we have the solution - output it and stop
4. If not, discard the first item in the list and if there are still at least 3 items in the list go back to step 2.
5. If you get here, there is no solution.

Why does this work?

In a reverse sorted list, the first three numbers are the three largest in the list, and clearly their sum is the largest possible triplet sum, so that's rule 5 taken care of.

For any three reverse sorted numbers m, n and o, rules 1 and 3 will always be satisfied because any sum involving m is already larger than o, so we only need to do test 2. If that succeeds, we have the solution, because no subsequently found triplet will have a larger sum.

If it fails, then no solution can contain m, because if n + o doesn't exceed m then no other pair will. So we can discard m and work on the next triplet (n, o and p) in the same way.

Try it 

Try running the script with any input:

Your @n =

example: 1, 2, 3, 2

Script

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.28;    # The Weekly Challenge - 2022-10-17
use utf8;     # Week 187 - task 2 - Magical triplets
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Algorithm::Combinatorics qw[variations];

my (@tests, $test, $iter, $triplet, $sum, $max, @triplet, @results, $r, $j, @rand, @this);

@tests = ([1, 2, 3, 2], [1, 3, 2], [1, 1, 2, 3], [2, 4, 3], [1, 2, 3, 4, 5, 6, 7],
    [1, 7, 13, 34, 51, 78, 0, 4, 56, 43, 199, 20], [1, 0, 0]);
    
for $j (0 .. 19) {
    $rand[$j] = int(rand(1000));
}
push @tests, \@rand;

say qq[\nMETHOD 1];

TEST: for $test (@tests) {
    
    say qq[\nInput:  (] . join(', ', @$test) . ')';

    $max = 0;
    @results = ();
    
    # generate all possible triplets
    $iter = variations($test, 3);
    while ($triplet = $iter->next) {
        
        # apply tests 1 to 3
        next unless $triplet->[0] + $triplet->[1] > $triplet->[2];
        next unless $triplet->[1] + $triplet->[2] > $triplet->[0];
        next unless $triplet->[0] + $triplet->[2] > $triplet->[1];
        
        # calc a + b + c and see if it is >= the max seen so far
        $sum = $triplet->[0] + $triplet->[1] + $triplet->[2];
        next unless $sum >= $max;
        @results = () if $sum > $max;
        push @results, [$triplet->[0], $triplet->[1], $triplet->[2]];
        $max = $sum;
    }

    # no solution
    if (scalar @results == 0) {
        say qq[Output: ()];
        
    # just one solution 
    } elsif (scalar @results == 1) {
        say qq[Output: ($results[0]->[0], $results[0]->[1], $results[0]->[2])];
        
    # several solutions: need to apply test 5 and select the first 
    } else {
        for $r (@results) {
            if ($r->[0] >= $r->[1] and $r->[1] >= $r->[2]) {
                say qq[Output: ($r->[0], $r->[1], $r->[2])];
                next TEST;
            }
        }
        
        # possibly they could all fail test 5
        say qq[Output: ()];  
    }
}

say qq[\nMETHOD 2];

TEST2: for $test (@tests) {
    
    # sort the input list into decreasing order
    @this = @$test;
    say qq[\nInput:  (] . join(', ', @this) . ')';
    @this = reverse (sort { $a <=> $b } @this);
    
    # work along the list until you find three successive elements a, b, c where a - b < c
    for $j (0 .. scalar @this - 3) {
        next if $this[$j] - $this[$j + 1] >= $this[$j + 2];
        say qq[Output: ($this[$j], $this[$j + 1], $this[$j + 2])];
        next TEST2;
    }
    
    # no such triplet meets the criteria
    say qq[Output: ()];
}

Output

METHOD 1

Input:  (1, 2, 3, 2)
Output: (3, 2, 2)

Input:  (1, 3, 2)
Output: ()

Input:  (1, 1, 2, 3)
Output: ()

Input:  (2, 4, 3)
Output: (4, 3, 2)

Input:  (1, 2, 3, 4, 5, 6, 7)
Output: (7, 6, 5)

Input:  (1, 7, 13, 34, 51, 78, 0, 4, 56, 43, 199, 20)
Output: (78, 56, 51)

Input:  (1, 0, 0)
Output: ()

Input:  (650, 337, 664, 958, 970, 292, 208, 781, 564, 628, 455, 273, 39, 598, 729, 365, 407, 675, 38, 966)
Output: (970, 966, 958)

METHOD 2

Input:  (1, 2, 3, 2)
Output: (3, 2, 2)

Input:  (1, 3, 2)
Output: ()

Input:  (1, 1, 2, 3)
Output: ()

Input:  (2, 4, 3)
Output: (4, 3, 2)

Input:  (1, 2, 3, 4, 5, 6, 7)
Output: (7, 6, 5)

Input:  (1, 7, 13, 34, 51, 78, 0, 4, 56, 43, 199, 20)
Output: (78, 56, 51)

Input:  (1, 0, 0)
Output: ()

Input:  (650, 337, 664, 958, 970, 292, 208, 781, 564, 628, 455, 273, 39, 598, 729, 365, 407, 675, 38, 966)
Output: (970, 966, 958)