Perl Weekly Challenge 351.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 351.
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
Two simple solutions are to sort the array, discard the first and last element and average the rest, or, slightly faster, sum all elements, subtract the minimum and maximum and divide by the number of elements minus two. Using the Perl Data Language this fits a one-liner.
Examples:
perl -MPDL -E '
for(@ARGV){$x=pdl($_);say "$_ -> ", ($x->sum-pdl($x->minmax)->sum)/($x->nelem-2)}
' "[8000 5000 6000 2000 3000 7000]" "[100000 80000 110000 90000]" \
"[2500 2500 2500 2500]" "[2000]" "[1000 2000 3000 4000 5000 6000]"
Results:
[8000 5000 6000 2000 3000 7000] -> 5250
[100000 80000 110000 90000] -> 95000
[2500 2500 2500 2500] -> 2500
[2000] -> 2000
[1000 2000 3000 4000 5000 6000] -> 3500
So examples 3 and 4 failed. The reason is that in one case there is
more than one instance of the maximum or the minimum and in the other
there is only one element. Thus, I need a different strategy. I can
identify the maximum and the minimum and remove all of their
repetitions, and then average the remaining numbers. I can use the
avg PDL method, but I have to check if there are no numbers left to
average, although averaging a null array is suspicious.
Examples:
perl -MPDL -E '
for(@ARGV){$x=pdl($_);$x=$x->where(($x!=$x->max)&($x!=$x->min));say "$_ -> ", $x->nelem?$x->avg:0}
' "[8000 5000 6000 2000 3000 7000]" "[100000 80000 110000 90000]" \
"[2500 2500 2500 2500]" "[2000]" "[1000 2000 3000 4000 5000 6000]"
Results:
[8000 5000 6000 2000 3000 7000] -> 5250
[100000 80000 110000 90000] -> 95000
[2500 2500 2500 2500] -> 0
[2000] -> 0
[1000 2000 3000 4000 5000 6000] -> 3500
The full code is:
1 # Perl weekly challenge 351
2 # Task 1: Special Average
3 #
4 # See https://wlmb.github.io/2025/12/08/PWC351/#task-1-special-average
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 S0 S1...
10 to obtain the special averages (the average after eliminating the minimum
11 and maximum values) of arrays Sn, where Sn are strings that represent the
12 arrays of the form "[V0 V1...]" and where Vn are numbers.
13 FIN
14 for(@ARGV){
15 try {
16 my $in=pdl($_);
17 my ($min, $max)=$in->minmax;
18 my $trimmed=$in->where(($in!=$max)&($in!=$min));
19 say "$_ -> ", $trimmed->nelem?$trimmed->avg:"0 or NaN?"; # average of 0 element array?
20 }
21 catch($e){
22 warn $e;
23 }
24 }
Example:
./ch-1.pl "[8000 5000 6000 2000 3000 7000]" "[100000 80000 110000 90000]" \
"[2500 2500 2500 2500]" "[2000]" "[1000 2000 3000 4000 5000 6000]"
Results:
[8000 5000 6000 2000 3000 7000] -> 5250
[100000 80000 110000 90000] -> 95000
[2500 2500 2500 2500] -> 0 or NaN?
[2000] -> 0 or NaN?
[1000 2000 3000 4000 5000 6000] -> 3500
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.
The arithmetic progression is necessarily sorted, so the first step is
to order the array. I can then compute the differences between
consecutive elements. If the progression is arithmetic all of those
differences would be equal, so the differences of the differences,
i.e., the second differences, would be zero. I can use a convolution
with the kernel [1,-2,1] to compute the second differences at all
inner points of the array, i.e., excluding the boundaries. To this end
I can use the conv1d method of PDL. The result fits a one-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$x=pdl($_); say "$_ -> ", $x->qsort->conv1d(pdl[1,-2,1])->(1:-2)->any?"F":"T"}
' "[1 3 5 7 9]" "[9 1 7 5 3]" "[1 2 4 8 16]" "[5 -1 3 1 -3]" "[1.5 3 0 4.5 6]"
Results:
[1 3 5 7 9] -> T
[9 1 7 5 3] -> T
[1 2 4 8 16] -> F
[5 -1 3 1 -3] -> T
[1.5 3 0 4.5 6] -> T
The full code is:
1 # Perl weekly challenge 351
2 # Task 2: Arithmetic Progression
3 #
4 # See https://wlmb.github.io/2025/12/08/PWC351/#task-2-arithmetic-progression
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 S0 S1...
10 to find if the arrays Sn correspond to an arithmetic progression.
11 Sn are strings with the format "[N0 N1...]" where Nn are numbers.
12 FIN
13 for(@ARGV){
14 try {
15 my $in=pdl($_);
16 my $sorted = $in->qsort;
17 my $second_diff=$sorted->conv1d(pdl[1,-2,1]) # second differences
18 ->slice("1:-2"); # remove first and last el.
19 my $result=($second_diff==0)->all?"True":"False";
20 say "$_ -> $result";
21 }
22 catch($e){
23 warn $e;
24 }
25 }
26
Example:
./ch-2.pl "[1 3 5 7 9]" "[9 1 7 5 3]" "[1 2 4 8 16]" "[5 -1 3 1 -3]" "[1.5 3 0 4.5 6]"
Results:
[1 3 5 7 9] -> True
[9 1 7 5 3] -> True
[1 2 4 8 16] -> False
[5 -1 3 1 -3] -> True
[1.5 3 0 4.5 6] -> True
/;