Perl Weekly Challenge 359.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 359.
Task 1: Digital Root
Submitted by: Mohammad Sajid Anwar
You are given a positive integer, $int.
Write a function that calculates the additive persistence of a positive
integer and also return the digital root.
Digital root is the recursive sum of all digits in a number until a
single digit is obtained.
Additive persistence is the number of times you need to sum the digits to reach a single digit.
Example 1
Input: $int = 38
Output: Persistence = 2
Digital Root = 2
38 => 3 + 8 => 11
11 => 1 + 1 => 2
Example 2
Input: $int = 7
Output: Persistence = 0
Digital Root = 7
Example 3
Input: $int = 999
Output: Persistence = 2
Digital Root = 9
999 => 9 + 9 + 9 => 27
27 => 2 + 7 => 9
Example 4
Input: $int = 1999999999
Output: Persistence = 3
Digital Root = 1
1999999999 => 1 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 => 82
82 => 8 + 2 => 10
10 => 1 + 0 => 1
Example 5
Input: $int = 101010
Output: Persistence = 1
Digital Root = 3
101010 => 1 + 0 + 1 + 0 + 1 + 0 => 3
I could obtain the digital root in one step using modular arithmetic, but I would still have to iterate to obtain the persistence. So I just follow the instructions splitting the numbers to obtain the digits and summing them to obtain the next number, and repeating until the result is one digit long. The result fits a simple one-liner.
Examples:
perl -MList::Util=sum -E '
for(@ARGV){$r=$_;$p=0;$p++,$r=sum split"",$r while$r>9;say"$_ -> p=$p r=$r"}
' 38 7 999 1999999999 101010
Results:
38 -> p=2 r=2
7 -> p=0 r=7
999 -> p=2 r=9
1999999999 -> p=3 r=1
101010 -> p=1 r=3
The full code is:
1 # Perl weekly challenge 359
2 # Task 1: Digital Root
3 #
4 # See https://wlmb.github.io/2026/02/02/PWC359/#task-1-digital-root
5 use v5.36;
6 use feature qw(try);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N0 N1...
9 to find the persistence and digital root of the numbers Nm
10 FIN
11 use List::Util qw(sum0);
12 for(@ARGV){
13 try {
14 die "Only digits allowed: $_" unless /^\d+$/;
15 my $root = $_;
16 my $persistence = 0;
17 ++$persistence, $root=sum0 split "", $root while $root>9;
18 say "$_ -> persistence=$persistence, root=$root";
19 }
20 catch($e){ warn $e };
21 }
Examples:
./ch-1.pl 38 7 999 1999999999 101010
Results:
38 -> persistence=2, root=2
7 -> persistence=0, root=7
999 -> persistence=2, root=9
1999999999 -> persistence=3, root=1
101010 -> persistence=1, root=3
Task 2: String Reduction
Submitted by: Mohammad Sajid Anwar
You are given a word containing only alphabets,
Write a function that repeatedly removes adjacent duplicate characters
from a string until no adjacent duplicates remain and return the final word.
Example 1
Input: $word = "aabbccdd"
Output: ""
Iteration 1: remove "aa", "bb", "cc", "dd" => ""
Example 2
Input: $word = "abccba"
Output: ""
Iteration 1: remove "cc" => "abba"
Iteration 2: remove "bb" => "aa"
Iteration 3: remove "aa" => ""
Example 3
Input: $word = "abcdef"
Output: "abcdef"
No duplicate found.
Example 4
Input: $word = "aabbaeaccdd"
Output: "aea"
Iteration 1: remove "aa", "bb", "cc", "dd" => "aea"
Example 5
Input: $word = "mississippi"
Output: "m"
Iteration 1: Remove "ss", "ss", "pp" => "miiii"
Iteration 2: Remove "ii", "ii" => "m"
I use a regular expression (.)\1 to capture a letter and if it is
followed by itself, substitute it by a null string, and do this
repeatedly while the pattern matches. The result is whatever remains
of the string. The result fits a half-liner.
Examples:
perl -E '
for(@ARGV){$i=$_;1 while s/(.)\1//g; say "$i -> $_"}
' aabbccdd abccba abcdef aabbaeaccdd mississippi
Results:
aabbccdd ->
abccba ->
abcdef -> abcdef
aabbaeaccdd -> aea
mississippi -> m
The full code is similar:
1 # Perl weekly challenge 359
2 # Task 2: String Reduction
3 #
4 # See https://wlmb.github.io/2026/02/02/PWC359/#task-2-string-reduction
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S0 S1...
8 to remove adjacent duplicated characters from the strings Sn.
9 FIN
10 for(@ARGV){
11 my $in=$_;
12 1 while s/(.)\1//g;
13 say "$in -> $_";
14 }
Examples:
./ch-2.pl aabbccdd abccba abcdef aabbaeaccdd mississippi
Results:
aabbccdd ->
abccba ->
abcdef -> abcdef
aabbaeaccdd -> aea
mississippi -> m
/;
Written on February 2, 2026