E. Choroba

I spent this week in Rīga at the Perl Conference. I had two talks there, a standard 20-minutes one and a lightning talk (5 minutes). I dedicated all my free time to the preparation of the slides, but fortunately the assignments were rather easy this week, so I submitted the solutions on Monday already before leaving for Rīga.

Split on change

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”.

Unfortunately, there’s no \b{scb} “same character boundary” on which we could split the string. In order to find it, we have to capture one character, and check that the next one is different. But capture groups are preserved in split output, which pollutes the output with the matched characters:

$ perl -wE 'say join "-", split /(?<=(.))(?!\1)/, "ABBCDEEF"'
A-A-BB-B-C-C-D-D-EE-E-F-F

We can use grep to select the odd elements only:

$ perl -wE 'say join "-", grep ++$a % 2, split /(?<=(.))(?!\1)/, "ABBCDEEF"'
A-BB-C-D-EE-F

It seems much more complex than “split on character change”, so I tried to find a simpler solution. Not using split doesn’t help much:

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

In order to find a repeating character, we must first capture it, and it pollutes the output again!

If we know that the input will consist of letters A .. F, we can use a very simple regex, though:

$ perl -wE 'say join "-", "ABBCDEEF" =~ /A+|B+|C+|D+|E+|F+/g'
A-BB-C-D-EE-F

If we don’t know what characters will be present, we can still build the regex dynamically:

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use List::Util qw{ uniq };

sub split_on_change {
    my ($string) = @_;
    my $regex = join '|', map quotemeta($_) . '+', uniq(split //, $string);
    $string =~ /$regex/g
}

use Test::More tests => 1;
is_deeply [split_on_change('ABBCDEEF')],
          [qw[ A BB C D EE F ]];

I’m quite curious whether any other participant has found a solution directly reflecting the assignment.

Amicable numbers

Write a script to print the smallest pair of Amicable Numbers.

I’ve only met amicable numbers when solving the Contest Coding (see Amicable Numbers). I just had to adapt the solution, in this case meant to simplify it.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw(say);

use List::Util qw{ sum0 };

sub sum_divisors {
    my $n = shift;
    return sum0(grep 0 == $n % $_, 1 .. $n - 1)
}

my ($a1, $a2) = (0, 0);
until ($a1 == sum_divisors($a2) && $a1 < $a2) {
    $a2 = sum_divisors(++$a1);
}
say "$a1 $a2";