E. Choroba

This time, the first challenge was more difficult than the second one. So, let’s start with the easier one.

Centring

To centre an array of lines, just find the longest one, and prolong each line on both sides so its length is the same as the maximal one. When printing, we don’t have to prolong the right hand sides of the lines, prefixing the spaces to the left is enough.

#!/usr/bin/perl
use warnings;
use strict;

use Path::Tiny;
use List::Util qw{ max };

sub center {
    my @lines = @_;
    my $max_length = max(map length, @lines);
    return map +(' ' x (($max_length - length) / 2)) . $_, @lines
}

my @lines = path(shift)->lines;
print for center(@lines);

Perfect Numbers

The naive approach to find the first five perfect numbers is to iterate over all the numbers and print those that are perfect.

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

use List::Util qw{ sum };

use constant COUNT => 5;

sub is_perfect {
    my ($n) = @_;
    my @divisors = grep 0 == $n % $_, 1 .. $n - 1;
    return sum(@divisors) == $n
}

my $n = 2;
my $so_far = 0;
while ($so_far < COUNT) {
    ++$so_far, say $n if is_perfect($n);
    ++$n
}

Unfortunately, it takes 3 seconds to find the first four perfect numbers, and searching for the fifth one would take hours.

I tried to speed it up by only dividing each number by primes discovered so far, summing all the possible subsets of all the prime divisors. It finds the first four perfect numbers in half a second, but the fifth one still takes too long.

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

use constant COUNT => 5;

my @primes = (2);

sub sum_subsets {
    my ($p, @numbers) = @_;
    my $binary        = 1;
    my $sum           = 1; # Always a divisor.
    my %seen;

    while (1) {
        my @zero_ones = split //, sprintf '%b', $binary++;
        unshift @zero_ones, (0) x (@numbers - @zero_ones);
        last unless grep ! $_, @zero_ones;

        my $divisor = 1;
        $divisor *= $numbers[$_] for grep $zero_ones[$_], 0 .. $#zero_ones;
        next if exists $seen{$divisor};

        undef $seen{$divisor};
        $sum += $divisor;
        last if $sum > $p;
    }
    return $sum
}


sub factorize {
    my ($n)         = @_;
    my $prime_index = 0;
    my ($f, @factors);

    while ($n > 1) {
        $f = $primes[$prime_index] // ($f + 1);

        if ($n % $f) {
            $prime_index++;

        } else {
            push @factors, $f;
            $n /= $f;
        }
    }
    return @factors
}

my $perfect_tally = 0;
my $p = 2;
while ($perfect_tally < COUNT) {
    my @factors = factorize($p);
    if (1 == @factors and $p > $primes[-1]) {
        push @primes, $p;
    }
    my $product = sum_subsets($p, @factors);
    if ($product == $p) {
        $perfect_tally++;
        say $p;
    }
} continue {
    $p++;
}

To really speed the program, we need to generate the numbers instead of filter them. To prove this program is correct, we need to read a bit more about the perfect numbers: the even ones can be generated by the formula (2 ** $p - 1) * 2 ** ($p - 1) where $p and 2 ** $p - 1 are both primes. It’s unclear whether any odd perfect number exists, but if it does, it’s greater than 10¹⁵⁰⁰. So, if all the five numbers our program outputs are less than 10¹⁵⁰⁰, we’ve found the first five perfect numbers.

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

use constant COUNT => 5;

my @primes = (2, 3);


sub add_primes {
    my ($upto) = @_;

  PRIME:
    for my $n ($primes[-1] + 2 .. $upto) {
        for my $p (@primes) {
            next PRIME if 0 == $n % $p;

            last if $p > sqrt $n;
        }
        push @primes, $n;
    }
}


sub is_prime {
    my ($n) = @_;
    return if $n == 1;

    add_primes($n) if $n > $primes[-1];

    for my $p (@primes) {
        return 1 if $p >= $n;

        return if 0 == $n % $p;
    }
}

my $n = 1;
my $tally = 0;
while ($tally < COUNT) {
    if (is_prime($n) && is_prime(2 ** $n - 1)) {
        say +(2 ** $n - 1) * 2 ** ($n - 1);
        ++$tally;
    }
    ++$n;
}

The first five numbers are printed in an instant. Even listing the first seven ones takes less than a second. Generating the eighth one, though, takes forever again.