Task — Distinct average

You are given an array of numbers with even length. Write a script to return the count of distinct average. The average is calculate by removing the minimum and the maximum, then average of the two.

Examples

Example 1
Input: @nums = (1, 2, 4, 3, 5, 6)
Output: 1
Step 1: Min = 1, Max = 6, Avg = 3.5
Step 2: Min = 2, Max = 5, Avg = 3.5
Step 3: Min = 3, Max = 4, Avg = 3.5
The count of distinct average is 1.

Example 2
Input: @nums = (0, 2, 4, 8, 3, 5)
Output: 2
Step 1: Min = 0, Max = 8, Avg = 4
Step 2: Min = 2, Max = 5, Avg = 3.5
Step 3: Min = 3, Max = 4, Avg = 3.5
The count of distinct average is 2.

Example 3
Input: @nums = (7, 3, 1, 0, 5, 9)
Output: 2uh
Step 1: Min = 0, Max = 9, Avg = 4.5
Step 2: Min = 1, Max = 7, Avg = 4
Step 3: Min = 3, Max = 5, Avg = 4
The count of distinct average is 2.

Analysis

Since we are consistently looking for the largest and smallest members of the array, it seems sensible to sort it. We can then pick off elements two at a time working inwards from the ends.

We are asked for the count of averages of these pairs, but as the average is just half the sum we can equivalently count unique sums and save the overhead of division and any problems concerning comparison of floating point numbers.

A convenient way to do that is simply to use a hash, setting $sums{$sum} = 1 for each pair and then just counting how many elements of the hash exist.

Try it 

#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2025-05-12
use utf8;     # Week 321 - task 1 - Distinct average
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

distinct_average(1, 2, 4, 3, 5, 6);
distinct_average(0, 2, 4, 8, 3, 5);
distinct_average(7, 3, 1, 0, 5, 9);

# larger example
my @numbers;
push @numbers, int(rand(100)) for 0 .. 99;
distinct_average(@numbers);

sub distinct_average {
    
    my (@numbers, $j, %sums, $count);
    
    @numbers = @_;
    say qq[\nInput:  (] . join(', ', @numbers) . q[)];
    
    # sort numbers and sum them pairwise from each end
    @numbers = sort {$a <=> $b}  @numbers;
    $sums{$numbers[$_] + $numbers[$#numbers - $_]} = 1 for 0 .. @numbers / 2;
    
    # count the number of unique sums
    $count ++ for keys %sums;
    
    say qq[Output: $count];
}

Output

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

Input:  (0, 2, 4, 8, 3, 5)
Output: 2

Input:  (7, 3, 1, 0, 5, 9)
Output: 2

Input:  (24, 2, 21, 5, 15, 69, 7, 97, 50, 23, 53, 51, 54,
   0, 19, 67, 14, 34, 12, 56, 8, 20, 0, 23, 93, 22, 48,
   99, 79, 58, 90, 52, 36, 69, 38, 70, 97, 6, 14, 35, 50,
   25, 84, 45, 23, 61, 7, 74, 2, 90, 72, 90, 77, 44, 52,
   90, 31, 3, 83, 62, 97, 82, 69, 3, 98, 12, 97, 1, 81,
   32, 3, 73, 10, 87, 61, 81, 19, 59, 26, 96, 75, 91, 97,
   93, 77, 56, 17, 4, 23, 56, 79, 66, 95, 38, 95, 61, 45,
   19, 41, 99)
Output: 11