# Finding Perfect Numbers in Perl

## The Problem

This solves **Challenge #1** in this week’s Perl Weekly Challenge.

Write a script that computes the first five perfect numbers. A perfect number is an integer that is the sum of its positive proper divisors (all divisors except itself). Please check Wiki for more information. This challenge was proposed by

Laurent Rosenfeld.

## First Pass

The solution, or at least the test, is in the Wikipedia page, but here it is.

6 = 1 + 2 + 3

The sum of all a number’s factors not including the number itself must equal the number. So, let’s check *all the numbers!*

```
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say signatures };
no warnings qw{ experimental::signatures };
use List::Util qw{sum};
say join "\n", perfect_numbers();
sub perfect_numbers {
my @numbers;
my $n = 0;
while ( scalar @numbers < 5 ) {
$n++;
next unless $n % 2 == 0; # they're all even, so this halves time
my @factors = factor($n);
my $sum = sum @factors;
push @numbers, $n if $sum eq $n;
}
return @numbers;
}
sub factor ( $n ) {
my @factors;
for my $i ( 1 .. $n - 1 ) {
push @factors, $i if $n % $i == 0;
}
return @factors;
}
```

This is not the *wrong* solution. It will give you the right solution.

Eventually.

Why? Because the first five perfect numbers are `[ 6 ,28 ,496 ,8128 ,33550336 ]`

, and counting past 33 million takes a while.

So, we don’t do that.

## Second Pass

In the section on Even Perfect Numbers, we get **2 ^{p-1}(2^{p} − 1)**, but not every

*even perfect number*is a

*perfect number*, but when p is

*prime*, that’s what we get. So…

```
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say signatures };
no warnings qw{ experimental::signatures };
use List::Util qw{sum};
say join "\n", perfect_numbers();
sub perfect_numbers {
my @numbers;
my $p = 1;
while ( scalar @numbers < 5 ) {
$p++;
next unless is_prime($p);
my $q = $p - 1;
my $o = ( 2**$q ) * ( ( 2**$p ) - 1 );
next unless is_perfect($o);
push @numbers, $o;
}
return @numbers;
}
sub is_perfect ( $n ) {
my @factors = factor($n);
my $sum = sum @factors;
return $sum == $n ? 1 : 0;
}
sub is_prime ( $n ) {
my @factors = factor($n);
return scalar @factors == 1 ? 1 : 0;
}
sub factor ( $n ) {
my @factors;
for my $i ( 1 .. $n - 1 ) {
push @factors, $i if $n % $i == 0;
}
return @factors;
}
```

```
$ time ~/pc008c1_2.pl
6
28
496
8128
33550336
real 0m2.911s
user 0m2.901s
sys 0m0.005s
```

Instead of *hours*, it takes seconds.

If you have any questions or comments, I would be glad to hear it. Ask me on Twitter or make an issue on my blog repo.