Root Reduction
with Raku

by Arne Sommer

Root Reduction with Raku

[383] Published 7. February 2026.

This is my response to The Weekly Challenge #359.

#359.1 Digital Root 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

File: digital-root 
#! /usr/bin/env raku

unit sub MAIN (Int $int is copy where $int > 0,  # [1]
               :v(:$verbose));

my $persistence = 0;                             # [2]

while $int.chars > 1                             # {3]
{
  $persistence++;                                # [4]

  my $new = $int.comb.sum;                       # [5]

  say ": [$persistence] $int -> $new" if $verbose;

  $int = $new;                                   # [6]
}

say "Persistence  = $persistence";               # [7]
say "Digital Root = $int";                       # [7a]

[1] The is copy trait is there so that we can edit the local copy (which we do in [6]) of the positive integer.

See docs.raku.org/type/Parameter#method_copy for more information about is copy.

[2] The persistence will end up here.

[3] As long as the integer has more than one digit.

[4] Add to the persistence.

[5] Get the sum of the individual digits.

[6] Update the integer.

[7] Print the result; the persistence and the final one-digit integer [7a].

Running it: 

$ ./digital-root 38
Persistence  = 2
Digital Root = 2

$ ./digital-root 7
Persistence  = 0
Digital Root = 7

$ ./digital-root 999
Persistence  = 2
Digital Root = 9

$ ./digital-root 1999999999
Persistence  = 3
Digital Root = 1

$ ./digital-root 101010
: [1] 101010 -> 3

Looking good.

With verbose mode: 

$ ./digital-root -v 38
: [1] 38 -> 11
: [2] 11 -> 2
Persistence  = 2
Digital Root = 2

$ ./digital-root -v 7
Persistence  = 0
Digital Root = 7

$ ./digital-root -v 999
: [1] 999 -> 27
: [2] 27 -> 9
Persistence  = 2
Digital Root = 9

$ ./digital-root -v 1999999999
: [1] 1999999999 -> 82
: [2] 82 -> 10
: [3] 10 -> 1
Persistence  = 3
Digital Root = 1

$ ./digital-root -v 101010
: [1] 101010 -> 3
Persistence  = 1
Digital Root = 3

#359.2 String Reduction 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"
File: string-reduction 
#! /usr/bin/env raku

unit sub MAIN ($word is copy where $word ~~ /^ <[a..z A..Z]>+ $/,  # [1]
               :v(:$verbose));

while $word ~~ /(.)$0/                                             # [2]
{
  my $remove = "$0$0";                                             # [3]
  my $new    = $word.subst($remove);                               # [4]

  say ": $word - $remove = $new" if $verbose;

  $word = $new;                                                    # [5]
}

say $word;                                                         # [6]

[1] A word consisting of Ascii letters only, both upper- and lowercase, with at least one.

[2] As long as we have a match (the first one from the left hand side) of two identical characters.

[3] Duplicate the character (as we are going to remove both).

[4] Use subst to remove the two characters.

See docs.raku.org/routine/subst for more information about subst.

[5] Update the original word.

[6] Print the result.

Running it: 

$ ./string-reduction aabbccdd


$ ./string-reduction abccba


$ ./string-reduction abcdef
abcdef

$ ./string-reduction aabbaeaccdd
aea

$ ./string-reduction mississippi

m

Looking good.

With verbose mode: 

$ ./string-reduction -v aabbccdd
: aabbccdd - aa = bbccdd
: bbccdd - bb = ccdd
: ccdd - cc = dd
: dd - dd = 


$ ./string-reduction -v abccba
: abccba - cc = abba
: abba - bb = aa
: aa - aa = 


$ ./string-reduction -v abcdef
abcdef

$ ./string-reduction -v aabbaeaccdd
: aabbaeaccdd - aa = bbaeaccdd
: bbaeaccdd - bb = aeaccdd
: aeaccdd - cc = aeadd
: aeadd - dd = aea
aea

$ ./string-reduction -v mississippi
: mississippi - ss = miissippi
: miissippi - ii = mssippi
: mssippi - ss = mippi
: mippi - pp = mii
: mii - ii = m
m

Note that this program start from the start of the string each time when looking for duplicates. The examples imply that the search should continue left to right, and then start over. The challenge text does not actually say that we should do it this way. It should not matter for the result, but the notion of iterations (the number of left to right passes) is missing in my solution. That number is not part of the answer, so we are good to go.

And that's it.

Links
 About me
 Keyword Index
 Beginning Raku (book)
 RSS Feed
 Code (zip)
Reddit Comments