RogerBW's Blog

I've been doing the Perl Weekly Challenges. This one dealt with string splitting and amicable numbers.

The first challenge was to split a string on change of character: so ABBCDD would become A, BB, C, DD. This is clearly a job for regular expressions, but referring to a capturing pattern within the same expression needs a syntax I wasn't previously aware of, the \g backreference. This returns pairs of captures, which I join with pairmap from List::Util.

sub splitchange {
  return pairmap {$a.$b} shift =~ /(.)(\g1*)/g;
}

In Perl6, this escape is no longer present, and you need to interpolate a code block into the regex in order to backreference within the same context, which I find rather uglier. (How odd, since I find most of Perl6's changes to regex syntax rather good.) On the other hand I get a $&-equivalent for each capture, so the pairmap is unnecessary.

sub splitchange ($in) {
   return map {$_.Str}, $in ~~ m:g/(.) {} :my $c = $0; ($c*)/;
}

Finding amicable numbers is more of a brute-force problem. And when there's heavy numerical lifting to be done, I resort to BigInt with a GMP back-end.

use Math::BigInt lib => 'GMP';
use Math::Prime::Util qw(divisors);

my $a=Math::BigInt->new(1);
while (1) {
  $a++;
  my @a=grep {$_ != $a} divisors($a);
  my $b=sum(@a);

Without this optimisation, we'll check each pair twice...

  if ($b <= $a) {
    next;
  }
  my @b=grep {$_ != $b} divisors($b);
  my $aa=sum(@b);
  if ($aa == $a) {
    print "$a, $b\n";
  }
}

The perl6 version is rather slower since, if there's a fast divisors function in the language base, I haven't found it. So I wrote my own, which isn't pretty, but it works. (There's no need to output the divisors in order, so a SetHash – somewhat like a hash, but constrained such that the values are irrelevant as long as they're non-zero – seems like an appropriate tool.)

my $a=1;
while (1) {
  $a++;
  my @a=divisors_unself($a);
  my $b=@a.sum;
  if ($b <= $a) {
    next;
  }
  my @b=divisors_unself($b);
  my $aa=@b.sum;
  if ($aa == $a) {
    print "$a, $b\n";
  }
}

sub divisors_unself ($k) {
  my SetHash $dd .= new;
  $dd{ 1 }++;
  for 2..$k.sqrt.Int -> $d {
    if ($k % $d == 0) {
      $dd{ $d }++;
      $dd{ $k/$d }++;
    }
  }
  return $dd.keys;
}