Perl Weekly Challenge # 20: Split String on Character Change and Amicable Numbers

These are some answers to the Week 20 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in several days from now (August 11, 2019). This blog post offers some solutions to this challenge, please don't read on if you intend to complete the challenge on your own.

Challenge # 1: Split String on Character Change (P5 and P6)

Write a script to accept a string from command line and split it on change of character. For example, if the string is "ABBCDEEF", then it should split like "A", "BB", "C", "D", "EE", "F".

For this, it seemed fairly obvious to me that a simple regex in a one-liner should do the trick. Well, it turned out to be slightly more complicated that I anticipated in Perl 5. For example, running this very simple Perl 5 one-liner:

$ perl -E 'say join " ", "ABBCDEEF" =~ /((.)\2*)/g;'
A A BB B C C D D EE E F F

does more or less the splitting job correctly, but does not provide the desired output: we get one unwanted extra field for each wanted field. We can decide to filter out the unwanted fields:

$ perl -E 'my @a = "ABBCDEEF" =~ /((.)\2*)/g; say join " ", map $a[$_], grep {not $_ % 2} 0..$#a;'
A BB C D EE F

$ perl -E 'my @a = "ABBBCDEEF" =~ /((.)\2*)/g; say join " ", map $a[$_], grep {$_ % 2 == 0} 0..$#a;'
A BBB C D EE F

That seems to work fine.

But there is in fact a simpler way to do it. The reason for the repeated fields is that we have two pairs of capturing parentheses, and we need both of them for the regex to work properly. But we can easily print only one of the captures (i.e. only $1):

$ perl -E 'print "\"$1\" " while "ABBCDEEF" =~ /((.)\2*)/g;'
"A" "BB" "C" "D" "EE" "F"

For some reason, my original P5 try works fine with Perl 6 (with the necessary syntax changes) without having to filter out anything, as shown below:

$ perl6 -e 'say ~$/ if "ABBBCDEEF" ~~ m:g/((.)$0*)/;'
A BBB C D EE F

$ perl6 -e 'say ~$/ if "ABBCDEEF" ~~ m:g/((.)$0*)/;'
A BB C D EE F

Challenge # 2: Amicable Numbers

Write a script to print the smallest pair of Amicable Numbers. For more information, please checkout wikipedia page.

Amicable numbers are two different numbers so related that the sum of the proper divisors of each is equal to the other number. (A proper divisor of a number is a positive factor of that number other than the number itself. For example, the proper divisors of 6 are 1, 2, and 3.)

Amicable Numbers in Perl 5

We'll use the sum_divisors subroutine to find the divisors of a given number and return their sum. Then, we just loop over integers from 2 onward and call sum_divisors subroutine. If the sum of divisors is larger than the integer being examined (if it is smaller, then it is a number that we have already checked), then we check the sum of divisors of the sum of divisors. If it is equal to the integer, then we've found two amicable numbers.

#!/usr/bin/perl
use strict;
use warnings;
use feature "say";

sub sum_divisors {
    my $num = shift;
    my $limit = int $num / 2 ;
    my $sum = 1;
    for my $test_div (2..$limit) {
        $sum += $test_div if $num % $test_div == 0;
    }
    return $sum;
}

my $i = 2;
while (1) {
    my $sum_div = sum_divisors $i;
    if ($sum_div > $i and $i == sum_divisors $sum_div) {
        say "$i and $sum_div are amicable numbers";
        last;
    }
    $i++
}

Note that since we don't know in advance how large the first amicable numbers will be, we build an infinite loop and break out of it when we've found the first amicable numbers.

This program displays the following correct result:

$ perl amicable_nrs.pl
220 and 284 are amicable numbers

Amicable Numbers in Perl 6

We'll also use a sum_divisors subroutine doing something similar to the one in the P5 solution (but doing it in a somewhat simpler way). And loop over a lazy infinite list of integers with essentially the same algorithm as the P5 implementation.

use v6;

sub sum-divisors (Int $num) {
    my @divisors = grep { $num %% $_ }, 2..($num / 2).Int;
    return [+] 1, | @divisors;
}

for 2..Inf -> $i {
    my $sum_div = sum-divisors $i;
    if $sum_div > $i and $i == sum-divisors $sum_div {
        say "$i and $sum_div are amicable numbers";
        last;
    }
}

This program prints the same thing as the P5 program:

$ perl6 amicable_nrs.p6
220 and 284 are amicable numbers

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, August 18. And, please, also spread the word about the Perl Weekly Challenge if you can.

Leave a comment

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about Perl (5 and 6).