Perl Weekly Challenge 306.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 306.
Task 1: Odd Sum
Submitted by: Mohammad Sajid Anwar
You are given an array of positive integers, @ints.
Write a script to return the sum of all possible odd-length subarrays of the given array.
A subarray is a contiguous subsequence of the array.
Example 1
Input: @ints = (2, 5, 3, 6, 4)
Output: 77
Odd length sub-arrays:
(2) => 2
(5) => 5
(3) => 3
(6) => 6
(4) => 4
(2, 5, 3) => 10
(5, 3, 6) => 14
(3, 6, 4) => 13
(2, 5, 3, 6, 4) => 20
Sum => 2 + 5 + 3 + 6 + 4 + 10 + 14 + 13 + 20 => 77
Example 2
Input: @ints = (1, 3)
Output: 4
Consider N numbers ni, i=0..N-1, and all possible groups of g consecutive terms (ni .. ni+g-1), i=0 .. N-g . The k-th term is repeated in the k groups (nk .. nk+g-1), (nk-1, nk .. nk+g-2), .. (nk-g+1..nk). However, we should remove from these groups (nk-i..nk-i+g-1) those where k-i is less than 0 or where k-i+g-1 > N-1. Thus, the number of repetitions of the k-th term is rgk=min(k+1, N-k, g, N-g+1). By summing these numbers over all possible group sizes (all odd numbers below N), I obtain the total number of repetitions of each term Rk=sumg rgk. Finally, the result is the sum of the products of nk with Rk. I can use PDL to perform the calculation. Closed formulas may be obtained for Rk, but I skipped them. Using the Perl Data Language, the results fits a two-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$i=pdl($_);$N=$i->dim(0);$z=zeroes($N,$N);$x=$z->xvals;$y=$z->yvals;$r=pdl($x+1,
$N-$x,$y+1, $N-$y)->mv(-1,0)->minover->mv(1,0)->(0:-1:2)->sumover;say "$i -> ",$r->inner($i)}
' "[2 5 3 6 4]" "[1 3]"
Result:
[2 5 3 6 4] -> 77
[1 3] -> 4
I explain with more detail in the full code below:
1 # Perl weekly challenge 306
2 # Task 1: Odd Sum
3 #
4 # See https://wlmb.github.io/2025/01/27/PWC306/#task-1-odd-sum
5 use v5.36;
6 use PDL;
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 A1 A2...
9 to compute the sum of all odd contiguous subarrays of the arrays
10 A1, A2.... The inputs A1 are strings of the form
11 ¨[N1 N2...Nn]" to be interpreted as arrays by PDL.
12 FIN
13 for(@ARGV){
14 my $input = pdl($_);
15 my $N = $input->dim(0);
16 my $zeroes = zeroes($N, $N); # indexed by d,g
17 my $d=$zeroes->xvals; # number positions
18 my $g=1+$zeroes->yvals; # group sizes
19 my $repetitions =
20 pdl(
21 $d+1,
22 $N-$d,
23 $g,
24 $N+1-$g # bounds of number of repetitions
25 )->mv(-1,0)->minover # number of repetitions for each term for each group size
26 ->mv(1,0)->slice([0,-1,2]) # restrict to odd group sizes
27 ->sumover; # actual number of repetitions for each term
28 my $output = $repetitions->inner($input); # multiply and sum
29 say "$input -> $output"
30 }
Example:
./ch-1.pl "[2 5 3 6 4]" "[1 3]"
Result:
[2 5 3 6 4] -> 77
[1 3] -> 4
Task 2: Last Element
Submitted by: Mohammad Sajid Anwar
You are given a array of integers, @ints.
Write a script to play a game where you pick two biggest integers in
the given array, say x and y. Then do the following:
a. if x == y then remove both from the given array
b. if x != y then remove x and replace y with (y - x)
At the end of the game, there is at most one element left.
Return the last element if found otherwise return 0.
Example 1
Input: @ints = (3, 8, 5, 2, 9, 2)
Output: 1
Step 1: pick 8 and 9 => (3, 5, 2, 1, 2)
Step 2: pick 3 and 5 => (2, 2, 1, 2)
Step 3: pick 2 and 1 => (1, 2, 2)
Step 4: pick 2 and 1 => (1, 2)
Step 5: pick 1 and 2 => (1)
Example 2
Input: @ints = (3, 2, 5)
Output: 0
Step 1: pick 3 and 5 => (2, 2)
Step 2: pick 2 and 2 => ()
I simply follow the instructions straightforwardly, without sophisticated tree structures and sorts, searching repeatedly for the maximum of the remaining elements. The result fits a two-liner. Notice that I put back the difference into the array, even when both maxima are equal, so that I don’t have to test for empty arrays.
Example 1:
perl -E '
@i=@ARGV;while(@i>1){$M=f(\@i);$m=f(\@i);push @i,$M-$m}say "@ARGV -> $i[0]";sub f($a){
@a=@$a;$m=$a[$i=0];($m<$a[$_])&&($m=$a[$i=$_]) for(1..@a-1);return splice @$a, $i,1}
' 3 8 5 2 9 2
Result:
3 8 5 2 9 2 -> 1
Example 2:
perl -E '
@i=@ARGV;while(@i>1){$M=f(\@i);$m=f(\@i);push @i,$M-$m}say "@ARGV -> $i[0]";sub f($a){
@a=@$a;$m=$a[$i=0];($m<$a[$_])&&($m=$a[$i=$_]) for(1..@a-1);return splice @$a, $i,1}
' 3 2 5
Result:
3 2 5 -> 0
The full code is:
1 # Perl weekly challenge 306
2 # Task 2: Last Element
3 #
4 # See https://wlmb.github.io/2025/01/27/PWC306/#task-2-last-element
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 N2 ...
8 to repeatedly replace the two largest numbers of an array
9 by their differernce, starting from N1 N2...
10 FIN
11 my @array = @ARGV;
12 while(@array > 1){
13 my $max = remove_max(\@array);
14 my $almost_max= remove_max(\@array);
15 push @array,$max-$almost_max
16 }
17 my $result = $array[0];
18 say "@ARGV -> $result";
19
20 sub remove_max($a){
21 my @a=@$a;
22 my $m=$a[my $i=0];
23 ($m<$a[$_])&&($m=$a[$i=$_]) for(1..@a-1);
24 return splice @$a, $i, 1;
25 }
Example 1:
./ch-2.pl 3 8 5 2 9 2
Result:
3 8 5 2 9 2 -> 1
Example 1:
./ch-2.pl 3 2 5
Result:
3 2 5 -> 0
/;