Perl Weekly Challenge 321.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 321.
Task 1: Distinct Average
Submitted by: Mohammad Sajid Anwar
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.
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: 2
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.
I can sort the inputs and the sum each number to that opposite to it
in the resulting list. The number of distinct averages is the same as the number
of distinct sums, so I apply uniq
from List::Utils
to find the
unique sums and convert the list to a scalar to find their
cardinality. The result fits a one-liner.
Example 1:
perl -MList::Util=uniq -E '
@x=sort {$a<=>$b}@ARGV;say "@ARGV -> ", 0+uniq map {$x[$_]+$x[-1-$_]}0..@ARGV/2-1;
' 1 2 4 3 5 6
Results:
1 2 4 3 5 6 -> 1
Recall that a negative index corresponds to counting from the end of the array.
Example 2:
perl -MList::Util=uniq -E '
@x=sort {$a<=>$b}@ARGV;say "@ARGV -> ", 0+uniq map {$x[$_]+$x[-1-$_]}0..@ARGV/2-1;
' 0 2 4 8 3 5
Results:
0 2 4 8 3 5 -> 2
Example 3:
perl -MList::Util=uniq -E '
@x=sort {$a<=>$b}@ARGV;say "@ARGV -> ", 0+uniq map {$x[$_]+$x[-1-$_]}0..@ARGV/2-1;
' 7 3 1 0 5 9
Results:
3 1 0 5 9 -> 2
The full code is similar:
1 # Perl weekly challenge 321
2 # Task 1: Distinct Average
3 #
4 # See https://wlmb.github.io/2025/05/12/PWC321/#task-1-distinct-average
5 use v5.36;
6 use List::Util qw(uniq);
7 my $N=@ARGV;
8 die <<~"FIN" unless $N && $N%2==0;
9 Usage: $0 N1 N2...N2n
10 to remove the smallest and largest value of the list, average them and
11 count the distinct values produced.
12 FIN
13 my @sorted = sort {$a <=> $b} @ARGV;
14 my $N2 = $N/2-1; #
15 say "@ARGV -> ", scalar uniq map {$sorted[$_]+$sorted[-1-$_]} 0..$N2;
Example:
./ch-1.pl 1 2 4 3 5 6
./ch-1.pl 0 2 4 8 3 5
./ch-1.pl 7 3 1 0 5 9
Results:
1 2 4 3 5 6 -> 1
0 2 4 8 3 5 -> 2
7 3 1 0 5 9 -> 2
Task 2: Backspace Compare
Submitted by: Mohammad Sajid Anwar
You are given two strings containing zero or more #.
Write a script to return true if the two given strings
are same by treating # as backspace.
Example 1
Input: $str1 = "ab#c"
$str2 = "ad#c"
Output: true
For first string, we remove "b" as it is followed by "#".
For second string, we remove "d" as it is followed by "#".
In the end both strings became the same.
Example 2
Input: $str1 = "ab##"
$str2 = "a#b#"
Output: true
Example 3
Input: $str1 = "a#b"
$str2 = "c"
Output: false
I can do a simple replacement in both strings to repeatedly remove characters (non-#) followed by a # and then compare them. The results fits a one-liner.
Example 1:
perl -E '
@x=@ARGV;($x, $y)=map{1while s/[^\#]\#//g;$_}@x;say "@ARGV -> ",$x eq $y?"True":"False";
' 'ab#c' 'ad#c'
Results:
ab#c ad#c -> True
Example 2:
perl -E '
@x=@ARGV;($x, $y)=map{1while s/[^\#]\#//g;$_}@x;say "@ARGV -> ",$x eq $y?"True":"False";
' 'ab##' 'a#b#'
Results:
ab## a#b# -> True
Example 3:
perl -E '
@x=@ARGV;($x, $y)=map{1while s/[^\#]\#//g;$_}@x;say "@ARGV -> ",$x eq $y?"True":"False";
' 'a#b' 'c'
Results:
a#b c -> False
The full code is:
1 # Perl weekly challenge 321
2 # Task 2: Backspace Compare
3 #
4 # See https://wlmb.github.io/2025/05/12/PWC321/#task-2-backspace-compare
5 use v5.36;
6 die <<~"FIN" unless @ARGV && @ARGV%2==0;
7 Usage: $0 A1 B1 A2 B2...
8 to find if strings An Bn are equal after all \#'s are
9 interpreted as backspace and applied to delete the preceding
10 character.
11 FIN
12 for my($x, $y)(@ARGV){
13 my ($x_edited, $y_edited) = ($x, $y); # make a copy
14 ($x_edited, $y_edited) = map {
15 1 while s/(^|[^\#])\#//g; # apply backspaces. Deal with # at beginning
16 $_; # return edited string
17 } ($x_edited, $y_edited);
18 my $result = $x_edited eq $y_edited? "True" : "False";
19 say "$x $y -> $result";
20 }
21
Example:
./ch-2.pl 'ab#c' 'ad#c' 'ab##' 'a#b#' 'a#b' 'c'
Results:
ab#c ad#c -> True
ab## a#b# -> True
a#b c -> False
#+endsrc