Perl Weekly Challenge 359

Task 1: Digital Root

"Number Crunching: Keep Summing Until One!"

Calculate the additive persistence (how many times to sum digits) and digital root (final single digit) of a positive integer.

The Strategy: Repeatedly sum digits until a single digit remains. Count the number of iterations for persistence.

Perl Implementation

sub digital_root_and_persistence ($n) {
    die "Expected positive integer\n" if $n !~ /^\d+$/ || $n < 1;
    my $persistence = 0;
    my $x           = $n;
    while ( length($x) > 1 ) {
        my $sum = 0;
        $sum += $_ for split //, $x;
        $x = $sum;
        ++$persistence;
    }
    return ( $persistence, 0 + $x );
}

Python Implementation

def digital_root_and_persistence(n: int) -> tuple[int, int]:
    """Return (persistence, digital_root) for a positive integer."""
    if n < 1:
        raise ValueError("n must be positive")
    
    persistence = 0
    x = n
    while len(str(x)) > 1:
        x = sum(int(d) for d in str(x))
        persistence += 1
    
    return persistence, x

Task 2: String Reduction

"Duplicate Demolition: Adjacent Twins Beware!"

Repeatedly remove adjacent duplicate characters from a string until no more exist.

The Strategy: Use regex to find and remove adjacent duplicates in a loop until no changes occur.

Perl Implementation

sub string_reduction {
    my ($word) = @_;
    my $prev = '';
    while ( $word ne $prev ) {
        $prev = $word;
        $word =~ s/(.)\1//g;
    }
    return $word;
}

Python Implementation

def string_reduction(word: str) -> str:
    """Remove adjacent duplicates until none remain."""
    prev = ""
    while word != prev:
        prev = word
        # Remove adjacent duplicate pairs
        i = 0
        result = []
        while i < len(word):
            if i + 1 < len(word) and word[i] == word[i + 1]:
                i += 2  # Skip the pair
            else:
                result.append(word[i])
                i += 1
        word = "".join(result)
    return word