Arithmetic triplets

You are given an array (3 or more members) of integers in increasing order and a positive integer. Write a script to find out the number of unique Arithmetic Triplets satisfying the following rules:

1. i < j < k
2. nums[j] - nums[i] == diff
3. nums[k] - nums[j] == diff

Examples

Example 1
Input: @nums = (0, 1, 4, 6, 7, 10)
       $diff = 3
Output: 2

Index (1, 2, 4) is an arithmetic triplet because both  7 - 4 == 3 and 4 - 1 == 3.
Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 == 3.

Example 2
Input: @nums = (4, 5, 6, 7, 8, 9)
       $diff = 2
Output: 2

(0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
(1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.

Analysis

On the face of it, this is dead simple: just have three nested loops over i, j and k and check for the specified conditions:

for $i (0 .. $last - 2) {
  for $j (1 .. $last - 1) {
    for $k (2 .. $last) {
      $count ++ if ($nums[$j] - $nums[$i] == diff
        and $nums[$k] - $nums[$j] == $diff);
    }
  }
}

And that works. But if the number of numbers in @nums is say 100, then the innermost loop will be executed nearly a million times, and that is going to take a while.

So we need to optimise. Firstly, let's note that the numbers are sorted. That means that when we're in the j loop, if numbers i and j don't differ by diff then there's no need to bother with the k loop. And if number j differs from number i by more than diff we can give up on the j loop because we know that any further numbers in that loop will differ from the i number by more than diff.

And of course we can do much the same in the k loop, abandoning it as soon as the k number exceeds the j number by more than diff.

With these optimisations I tried 1000 random numbers in (0 .. 9999) in @nums and $diff = 99 and it completed in a fraction of a second, finding 6 triplets.

So I think that's good enough. I tried (for about 5 minutes) to think up some sequence where the optimisations would not help - and failed.

Do It Yourself format of the post is the highlight for me. Highly recommended.

Try it 

#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-10-30
use utf8;     # Week 241 task 1 - Arithmetic triplets
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

arithmetic_triplets ([0, 1, 4, 6, 7, 10], 3);
arithmetic_triplets ([(4, 5, 6, 7, 8, 9)], 2);

# generate 200 sorted unique numbers in (0 .. 1999)
my ($j, @nums, $next, $count, @used);
$count = 0;
while ($count < 200) {
    $next = int(rand(2000));
    next if $used[$next];
    push(@nums, $next);
    $count ++;
    $used[$next] = 1;
}
@nums = sort { $a <=> $b } @nums;
arithmetic_triplets (\@nums, 19);

sub arithmetic_triplets {
    
    my (@nums, $diff, $last, $i, $j, $k, $count, $explain, $ji_diff, $kj_diff);
    
    # initialise
    @nums = @{$_[0]};
    $diff = $_[1];
    $last = @nums - 1;
    
    # loop over triplets
    $explain = '';
    $count = 0;
    
    # loop over i any i (except the last 2) could be part of a triplet
    for $i (0 .. $last - 2) {
        
        # loop over j
        for $j (1 .. $last - 1) {
            $ji_diff = $nums[$j] - $nums[$i];
            
            # if they differ by more than $diff then we can abandon this j
            last if $ji_diff > $diff;
            
            # unless this pair of i and j differ by $diff there's no need to check k
            next unless $ji_diff == $diff;
                        
            # loop over k
            for $k (2 .. $last) {
                $kj_diff = $nums[$k] - $nums[$j];
                
                # we can abandon this k if k differs from j by more than $diff
                last if ($kj_diff) > $diff;
                
                # and at last we've found an answer!
                if ($kj_diff == $diff) {
                    $count ++;
                    $explain .= qq{        \$nums[$i] = $nums[$i], \$nums[$j] = $nums[$j], \$nums[$k] = $nums[$k]\n};
                }
            }
        }
    }
    
    # show results
    say qq[\nInput:  \@nums = (] . join(q[, ], @nums) . q[)];
    say qq[        \$diff = $diff];
    say qq[Output: $count\n] . ($explain ? substr($explain, 0, -1) : '');
}
    

21 lines of code

Output from script

Input:  @nums = (0, 1, 4, 6, 7, 10)
        $diff = 3
Output: 2
        $nums[1] = 1, $nums[2] = 4, $nums[4] = 7
        $nums[2] = 4, $nums[4] = 7, $nums[5] = 10

Input:  @nums = (4, 5, 6, 7, 8, 9)
        $diff = 2
Output: 2
        $nums[0] = 4, $nums[2] = 6, $nums[4] = 8
        $nums[1] = 5, $nums[3] = 7, $nums[5] = 9

Input:  @nums = (2, 12, 36, 46, 80, 87, 97, 100, 109, 111, 114, 122, 142, 151, 158, 172, 182, 185, 195, 197, 200, 206, 210, 219, 230, 236, 237, 256, 260, 270, 275, 276, 277, 292, 298, 301, 304, 312, 313, 319, 329, 344, 348, 350, 359, 360, 367, 371, 376, 380, 408, 431, 435, 436, 442, 444, 452, 471, 512, 534, 546, 547, 559, 567, 571, 573, 582, 584, 587, 592, 596, 615, 624, 625, 651, 660, 672, 673, 683, 690, 709, 710, 729, 748, 761, 767, 798, 800, 811, 827, 830, 834, 842, 846, 872, 879, 887, 917, 920, 925, 949, 958, 967, 988, 993, 995, 1002, 1017, 1022, 1029, 1039, 1040, 1042, 1045, 1058, 1071, 1086, 1089, 1134, 1136, 1138, 1142, 1149, 1185, 1191, 1212, 1240, 1253, 1254, 1255, 1262, 1280, 1302, 1330, 1338, 1346, 1353, 1379, 1393, 1413, 1422, 1428, 1437, 1448, 1462, 1467, 1479, 1490, 1492, 1503, 1523, 1539, 1542, 1550, 1551, 1553, 1557, 1573, 1575, 1578, 1603, 1609, 1614, 1620, 1636, 1640, 1641, 1652, 1655, 1669, 1677, 1684, 1705, 1714, 1725, 1737, 1752, 1754, 1755, 1766, 1770, 1771, 1786, 1796, 1814, 1821, 1825, 1839, 1852, 1867, 1884, 1891, 1904, 1910, 1913, 1916, 1930, 1962, 1984, 1992)
        $diff = 19
Output: 4
        $nums[26] = 237, $nums[27] = 256, $nums[30] = 275
        $nums[40] = 329, $nums[42] = 348, $nums[46] = 367
        $nums[81] = 710, $nums[82] = 729, $nums[83] = 748
        $nums[82] = 729, $nums[83] = 748, $nums[85] = 767