Perl Weekly Challenge 340.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 340.

Task 1: Duplicate Removals

Submitted by: Mohammad Sajid Anwar
You are given a string, $str, consisting of lowercase English letters.

Write a script to return the final string after all duplicate removals have
been made. Repeat duplicate removals on the given string until we no longer can.

A duplicate removal consists of choosing two adjacent and equal letters and removing them.


Example 1
Input: $str = 'abbaca'
Output: 'ca'

Step 1: Remove 'bb' => 'aaca'
Step 2: Remove 'aa' => 'ca'

Example 2
Input: $str = 'azxxzy'
Output: 'ay'

Step 1: Remove 'xx' => 'azzy'
Step 2: Remove 'zz' => 'ay'

Example 3
Input: $str = 'aaaaaaaa'
Output: ''

Step 1: Remove 'aa' => 'aaaaaa'
Step 2: Remove 'aa' => 'aaaa'
Step 3: Remove 'aa' => 'aa'
Step 4: Remove 'aa' => ''

Example 4
Input: $str = 'aabccba'
Output: 'a'

Step 1: Remove 'aa' => 'bccba'
Step 2: Remove 'cc' => 'bba'
Step 3: Remove 'bb' => 'a'

Example 5
Input: $str = 'abcddcba'
Output: ''

Step 1: Remove 'dd' => 'abccba'
Step 2: Remove 'cc' => 'abba'
Step 3: Remove 'bb' => 'aa'
Step 4: Remove 'aa' => ''

I use a regular expression (.)\1 to capture any letter into $1 succeed if it is the same as the following letter. Then I repeatedly replace the matching strings by null strings. I repeat until there are no more adjacent duplicate letters. The code takes a half-liner.

perl -E '
for(@ARGV){$i=$_; 1while s/(.)\1//g; say "$i -> $_"}
' abbaca azxxzy aaaaaaaa aabccba abcddcba

Results:

abbaca -> ca
azxxzy -> ay
aaaaaaaa ->
aabccba -> a
abcddcba ->

The full code is:

 1  # Perl weekly challenge 340
 2  # Task 1:  Duplicate Removals
 3  #
 4  # See https://wlmb.github.io/2025/09/22/PWC340/#task-1-duplicate-removals
 5  use v5.36;
 6  die <<~"FIN" unless @ARGV;
 7      Usage: $0 S0 S1...
 8      to remove adjacent duplicate characters from the strings S0 S1...
 9      FIN
10  for(@ARGV){
11      my $input=$_;
12      1 while s/(.)\1//g;
13      say "$input -> $_"
14  }

Example:

./ch-1.pl abbaca azxxzy aaaaaaaa aabccba abcddcba

Results:

abbaca -> ca
azxxzy -> ay
aaaaaaaa ->
aabccba -> a
abcddcba ->

Task 2: Ascending Numbers

Submitted by: Mohammad Sajid Anwar
You are given a string, $str, is a list of tokens separated by
a single space. Every token is either a positive number consisting
of digits 0-9 with no leading zeros, or a word consisting of lowercase
English letters.

Write a script to check if all the numbers in the given string are
strictly increasing from left to right.


Example 1
Input: $str = "The cat has 3 kittens 7 toys 10 beds"
Output: true

Numbers 3, 7, 10 - strictly increasing.

Example 2
Input: $str = 'Alice bought 5 apples 2 oranges 9 bananas'
Output: false

Example 3
Input: $str = 'I ran 1 mile 2 days 3 weeks 4 months'
Output: true

Example 4
Input: $str = 'Bob has 10 cars 10 bikes'
Output: false

Example 5
Input: $str = 'Zero is 0 one is 1 two is 2'
Output: true

I can split the string on non-numbers and check that teh resulting array is invariant under a numerical sort and removal of duplicates. This yields a one-liner.

Examples:

perl -MList::Util=uniq -E '
for(@ARGV){@s=sort{$a<=>$b}uniq @i=split/[^0-9]+/; say "$_ -> ", "@s" eq "@i"?"True":"False"}
' "The cat has 3 kittens 7 toys 10 beds" 'Alice bought 5 apples 2 oranges 9 bananas' \
  'I ran 1 mile 2 days 3 weeks 4 months' 'Bob has 10 cars 10 bikes' 'Zero is 0 one is 1 two is 2'

Results:

The cat has 3 kittens 7 toys 10 beds -> True
Alice bought 5 apples 2 oranges 9 bananas -> False
I ran 1 mile 2 days 3 weeks 4 months -> True
Bob has 10 cars 10 bikes -> False
Zero is 0 one is 1 two is 2 -> True

The full code is:

 1  # Perl weekly challenge 340
 2  # Task 2:  Ascending Numbers
 3  #
 4  # See https://wlmb.github.io/2025/09/22/PWC340/#task-2-ascending-numbers
 5  use v5.36;
 6  use List::Util qw(uniq);
 7  for(@ARGV){
 8      my @splitted= grep {length>0} split/[^0-9]+/;  # split on non digits. May let some badly formed strings through
 9      my @sorted = sort {$a<=>$b} uniq @splitted; # remove duplicates and numerically sort all numbers
10      my $result = "@sorted" eq "@splitted"?"True":"False"; # join and compare as strings
11      say "$_ -> ", $result
12  }

Example:

./ch-2.pl "The cat has 3 kittens 7 toys 10 beds" 'Alice bought 5 apples 2 oranges 9 bananas' \
  'I ran 1 mile 2 days 3 weeks 4 months' 'Bob has 10 cars 10 bikes' 'Zero is 0 one is 1 two is 2'

Results:

The cat has 3 kittens 7 toys 10 beds -> True
Alice bought 5 apples 2 oranges 9 bananas -> False
I ran 1 mile 2 days 3 weeks 4 months -> True
Bob has 10 cars 10 bikes -> False
Zero is 0 one is 1 two is 2 -> True

/;

Written on September 22, 2025