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

Written on May 12, 2025