Peter
Peter Campbell Smith

Commons and pairs

Weekly challenge 277 — 8 July 2024

Week 277: 8 Jul 2024

Task 2

Task — Strong pair

You are given an array of integers, @ints. Write a script to return the count of all strong pairs in the given array. A pair of integers $x and $y is called a strong pair if it satisfies: 0 < |$x - $y| < min($x, $y).

Examples


Example 1
Input: @ints = (1, 2, 3, 4, 5)
Output: 4
Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)

Example 2
Input: @ints = (5, 7, 1, 7)
Output: 1
Strong Pairs: (5, 7)

Analysis

I have shown two ways to do this. The first method comprises two nested loops over @ints, testing every $x, $y aginst the stated criteria. I note from example 2 that duplicated answers (eg 5, 7) are to be reported just once.

The second method applies what might be some optimisation, in that @ints is first sorted. There are still two nested loops, but now we can abandon the inner loop as soon as abs($x - $y) exceeds $x, because the sorting means that any subsequent $y will make abs($x - $y) greater.

Both methods give the same answer, though in a different order.

Is method 2 faster? It's hard to say. The sort will take some time, though Perl's sort is pretty fast, but is the saving in the shortcut of the inner loop enough to overcome the penalty of the sort? I could not measure the difference.

Try it 

Try running the script with any input:



example: 1, 3, 5, 7, 9

Script


#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2024-07-08
use utf8;     # Week 277 - task 2 - Strong pair
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

my @ints;

strong_pair(1, 2, 3, 4, 5);
strong_pair(5, 7, 1, 7);
push @ints, int(rand(100)) for 0 .. 20;
strong_pair(@ints);

sub strong_pair {
    
    my (@ints, $i, $j, $x, $y, $output, $explain, %seen, $diff);
    
    # method 1 - initialise
    @ints = @_;
    $output = 0;
    $explain = '';
    
    # loop over all possible pairs
    for $i (0 .. @ints - 2) {
        for $j ($i + 1 .. @ints - 1) {
            ($x, $y) = ($ints[$i], $ints[$j]);
            
            # check conditions and record
            next unless 0 < abs($x - $y) and abs($x - $y) < ($x < $y ? $x : $y);
            next if $seen{qq[$x/$y]};
            $seen{qq[$x/$y]} = 1;
            $seen{qq[$y/$x]} = 1;
            $output += 1;
            $explain .= qq[($x, $y), ];
        }
    }
    
    printf(qq[\nInput:  \@ints = (%s)\n], join(', ', @ints));
    printf(qq[Output1: %s - %s\n], $output, $explain ? substr($explain, 0, -2) : '[none]');
    
    # method 2 - initialise
    $output = 0;
    $explain = '';
    %seen = ();
    
    # sort and then loop over all pairs
    @ints = sort { $a <=> $b } @ints;
    I: for $i (0 .. @ints - 2) {
        J: for $j ($i + 1 .. @ints - 1) {
            ($x, $y) = ($ints[$i], $ints[$j]);
            $diff = $y - $x;
            next J if $diff == 0 or $seen{qq[$x/$y]};
            
            # because @ints is sorted, increasing $j won't help
            next I if abs($diff) >= $x;
            $seen{qq[$x/$y]} = 1;
            $output += 1;
            $explain .= qq[($x, $y), ];
        }
    }
    printf(qq[Output2: %s - %s\n], $output, $explain ? substr($explain, 0, -2) : '[none]'); 
}

Output


Input: @ints = 1, 2, 3, 4, 5
Output1: 4 - (2, 3), (3, 4), (3, 5), (4, 5)
Output2: 4 - (2, 3), (3, 4), (3, 5), (4, 5)

Input: @ints = 5, 7, 1, 7
Output1: 1 - (5, 7)
Output2: 1 - (5, 7)

Input: @ints = 84, 63, 27, 58, 4, 5, 87, 58, 19, 53, 24,
   40, 54, 36, 56, 86, 55, 85, 63, 60, 12
Output1: 81 - (84, 63), (84, 58), (84, 87), (84, 53),
   (84, 54), (84, 56), (84, 86), (84, 55), (84, 85),
   (84, 60), (63, 58), (63, 87), (63, 53), (63, 40),
   (63, 54), (63, 36), (63, 56), (63, 86), (63, 55),
   (63, 85), (63, 60), (27, 19), (27, 53), (27, 24),
   (27, 40), (27, 36), (58, 87), (58, 53), (58, 40),
   (58, 54), (58, 36), (58, 56), (58, 86), (58, 55),
   (58, 85), (58, 60), (4, 5), (87, 53), (87, 54),
   (87, 56), (87, 86), (87, 55), (87, 85), (87, 60),
   (19, 24), (19, 36), (19, 12), (53, 40), (53, 54),
   (53, 36), (53, 56), (53, 86), (53, 55), (53, 85),
   (53, 60), (24, 40), (24, 36), (40, 54), (40, 36),
   (40, 56), (40, 55), (40, 60), (54, 36), (54, 56),
   (54, 86), (54, 55), (54, 85), (54, 60), (36, 56),
   (36, 55), (36, 60), (56, 86), (56, 55), (56, 85),
   (56, 60), (86, 55), (86, 85), (86, 60), (55, 85),
   (55, 60), (85, 60)
Output2: 81 - (4, 5), (12, 19), (19, 24), (19, 27),
   (19, 36), (24, 27), (24, 36), (24, 40), (27, 36),
   (27, 40), (27, 53), (36, 40), (36, 53), (36, 54),
   (36, 55), (36, 56), (36, 58), (36, 60), (36, 63),
   (40, 53), (40, 54), (40, 55), (40, 56), (40, 58),
   (40, 60), (40, 63), (53, 54), (53, 55), (53, 56),
   (53, 58), (53, 60), (53, 63), (53, 84), (53, 85),
   (53, 86), (53, 87), (54, 55), (54, 56), (54, 58),
   (54, 60), (54, 63), (54, 84), (54, 85), (54, 86),
   (54, 87), (55, 56), (55, 58), (55, 60), (55, 63),
   (55, 84), (55, 85), (55, 86), (55, 87), (56, 58),
   (56, 60), (56, 63), (56, 84), (56, 85), (56, 86),
   (56, 87), (58, 60), (58, 63), (58, 84), (58, 85),
   (58, 86), (58, 87), (60, 63), (60, 84), (60, 85),
   (60, 86), (60, 87), (63, 84), (63, 85), (63, 86),
   (63, 87), (84, 85), (84, 86), (84, 87), (85, 86),
   (85, 87), (86, 87)

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain