The Bear's Den

Enter at your own risk

12 December 2025 Challenge 351

Average Progression

Task 1: Special Average

Submitted by: Mohammad Sajid Anwar

You are given an array of integers.

Write a script to return the average excluding the minimum and maximum of the given array.

Example 1

Input: @ints = (8000, 5000, 6000, 2000, 3000, 7000)
Output: 5250

Min: 2000
Max: 8000
Avg: (3000+5000+6000+7000)/4 = 21000/4 = 5250

Example 2

Input: @ints = (100_000, 80_000, 110_000, 90_000)
Output: 95_000

Min: 80_000
Max: 110_000
Avg: (100_000 + 90_000)/2 = 190_000/2 = 95_000

Example 3

Input: @ints = (2500, 2500, 2500, 2500)
Output: 0

Min: 2500
Max: 2500
Avg: 0

Example 4

Input: @ints = (2000)
Output: 0

Min: 2000
Max: 2000
Avg: 0

Example 5

Input: @ints = (1000, 2000, 3000, 4000, 5000, 6000)
Output: 3500

Min: 1000
Max: 6000
Avg: (2000 + 3000 + 4000 + 5000)/4 = 14000/4 = 3500

Solution

Find the minimum and the maximum value from the list and take the arithmetic average over all elements that are distinct from the extrema.

Perl

The solution using PDL is straightforward.

use strict;
use warnings;
use PDL;

sub special_average {
    my $i = long @_;
    $i->where(!$i->in(long($i->minmax)))->avg;
}

See the full solution to task 1.

J

The logic in J is identical.

SpecialAvg =: {{(+/ % #) (#~ -.@(e. (<./ , >./))) y}}
NB.              GGGGGG   FF EE  DD  BBB C AAA

A minimum
B maximum
C join as list (fork B-C-A)
D check if an item is an extremum
E logical negation
F use the indicators for “inner” items as selector into the list (hook F-E…)
G calculate the arithmetic average over the remaining list (fork: sum divided by count)

echo SpecialAvg 8000 5000 6000 2000 3000 7000
exit ''

See the full solution.

Task 2: Arithmetic Progression

Submitted by: Mohammad Sajid Anwar

You are given an array of numbers.

Write a script to return true if the given array can be re-arranged to form an arithmetic progression, otherwise return false.

A sequence of numbers is called an arithmetic progression if the difference between any two consecutive elements is the same.

Example 1

Input: @num = (1, 3, 5, 7, 9)
Output: true

Already AP with common difference 2.

Example 2

Input: @num = (9, 1, 7, 5, 3)
Output: true

The given array re-arranged like (1, 3, 5, 7, 9) with common difference 2.

Example 3

Input: @num = (1, 2, 4, 8, 16)
Output: false

This is geometric progression and not arithmetic progression.

Example 4

Input: @num = (5, -1, 3, 1, -3)
Output: true

The given array re-arranged like (-3, -1, 1, 3, 5) with common difference 2.

Example 5

Input: @num = (1.5, 3, 0, 4.5, 6)
Output: true

The given array re-arranged like (0, 1.5, 3, 4.5, 6) with common difference 1.5.

Solution

General approach:

This approach is like taking a sledgehammer to crack a nut, but this is fun - at least for the sledgehammer.

Perl

PDL comes with the mrank function that can be use here. When processing floating point numbers, a tolerance needs to be specified.

use strict;
use warnings;
use PDL;
use PDL::NiceSlice;
use PDL::LinearAlgebra;

sub arith_progression {
    my $n = pdl(\@_, [0]);
    $n($n(,(0))->qsorti,1) .= sequence($n->dim(0));
    1 == mrank $n(1:-1) - $n(0), 1e-14;
}

See the full solution to task 2.

J

I couldn’t find a library function in J that calculates the rank of a matrix as simple as in PDL. With a provided mrank function, the logic is the same as in PDL.

Artificial constraints:

ArithProg =: {{1 = 1e_14 mrank (}. -"1 {.) |: (,: ((] i.~ /:~) i.@#)) y}}
NB.            LLL KKKKK JJJJJ  GG III HH  FF  EE   B DDD CCC  AAAA

A sequence in length of list
B list itself
C index sort (hook (BD)C-A)
D indices of list elements in sorted list (fork B-D-C)
E join list and indices
F transpose matrix
G tail rows of matrix
H first row of matrix
I diff to first row (fork G-I-H)
J matrix rank from own implementation
K tolerance
L rank shall be 1

A - D combine an index sort and a permutation inverse.

My first attempts to implement a mrank function based on math/mt’s gelpf or geprf failed. I was not able to reliably calculate the rank.

Therefore I ported PDL’s mrank function to J. It uses LAPACK’s dgesdd to calculate a singular value decomposition of a matrix directly. The rank is the number of (approximately) non-zero singular values.

The mrank function:

load 'math/lapack2'

mrank =: 3 : 0
    1e_10 mrank y
:
    assert. 2 = #@$ y
    'xS xU xVt xWork xInfo' =. 6 7 9 11 14
    'r c' =.   $ y
    caJobz =.  ,'A'                 NB. computing option
    iM =.      ,r                   NB. rows
    iN =.      ,c                   NB. cols
    iLda =.    iM                   NB. leading dim of A
    dmA =.     |: y                 NB. A, (LDA, N)
    daS =.     (iM <. iN) $ 0.      NB. S, (min(M, N))
    iLdu =.    iM                   NB. leading dim of U
    dmU =.     (iLdu, iM) $ 0.      NB. U, (LDU, M)
    iLdvt =.   iN                   NB. leading dim of VT
    dmVt =.    (iLdvt, iN) $ 0.     NB. VT (LDVT, N)
    iLwork =.  ,_1                  NB. dim of WORK
    daWork =.  (1 >. iLwork) $ 0.   NB. workspace (LWORK)
    iaIwork =. (8 * (iM <. iN)) $ 0 NB. internal workspace (8*min(M, N))
    iaInfo =.  ,_1                  NB. info

    ret =. dgesdd_jlapack2_ caJobz; iM; iN; dmA; iLda; daS; dmU; iLdu; dmVt; iLdvt; daWork; iLwork; iaIwork; iaInfo
    'daWork iaInfo' =. (xWork, xInfo) { ret
    assert. 0 = >iaInfo
    iLwork =. ,0 { daWork
    daWork =. (1 >. iLwork) $ 0.
    iaInfo =. ,_1 NB. info
    ret =. dgesdd_jlapack2_ caJobz; iM; iN; dmA; iLda; daS; dmU; iLdu; dmVt; iLdvt; daWork; iLwork; iaIwork; iaInfo
    'daS dmU dmVt iaInfo' =. (xS, xU, xVt, xInfo) { ret
    assert. 0 = >iaInfo
    +/ x < | daS
)

Lessons learned in J:

See the full solution to task 2.