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.

What a nice story around the date related task. Thanks for sharing the story. Well done.

This review may cover either or both challenges for this week.

I am sorry that the 'Try it' feature is currently working very slowly or not at all owing to some issue with my web hosting provider.

Try it 

Try running the script with any input:

Your @n =

example: 1, 2, 3, 2

⤡

#!/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: ()];
}

46 lines of code

Output from script

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)