derpp has asked for the wisdom of the Perl Monks concerning the following question:

Hiya, monks

I'm trying to write this program that finds perfect numbers from a range of 1-10000. I already had a program that found that factors of integers, and since all a perfect number is is a number that, when added up, equals the sum of its factors.

Here is my attempt: 
@numbers = (1..10000);
foreach $number (@numbers) {

for ($count = 1; $count <=10000; $count++)
{
    $result = $number / $count;
    unless ($result =~ /\./)
{
    push (@factor, $result);
}
}
}    

foreach $thing (@factor) {
    if ($result==$thing) {
       my @perfectnumbers = ( );
          push (@perfectnumbers, $result);
}
}
foreach (@perfectnumbers) {
    print "$_\n";

}

[download]

What i wanted to do was to get all the factors of every integer from 1 to 10000 and then when the integer equaled its factors, it would push it into the array. My problem lies in the fact that i'm not sure how to make perl do this. I also think that there are some problems with my factors.

Replies are listed 'Best First'.
Re: finding perfect numbers
by CountZero (Bishop) on Aug 05, 2010 at 19:56 UTC
    Using the power of CPAN:
    use strict;
use 5.012;

use Math::Factor::XS qw/factors/;
use List::Util qw/sum/;

for (2 ... 10000) {
    say "$_ is perfect" if sum(factors($_)) == $_ - 1;
}

    [download]

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

[reply]
[d/l]
      Thanks, this variant even works with warnings enabled and older Perls: 
      use strict;
use warnings;

use Math::Factor::XS qw/factors/;
use List::Util qw/sum/;

for (2 .. 10000) {
    print "$_ is perfect\n" if (sum(factors($_),0) == $_ - 1);
}

      [download]
[reply]
[d/l]
        Well done!

        And that made me think of the following small change:

        print "$_ is perfect\n" if (sum(factors($_),1) == $_);

        [download]
        Thanks for putting me on that track!

        CountZero

        A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

[reply]
[d/l]
Re: finding perfect numbers
by zek152 (Pilgrim) on Aug 05, 2010 at 19:56 UTC

    It's your lucky day! I coded an unoptimized solution. This runs pretty quickly (<10sec) but you could really improve the factor subroutine.

    my @numbers = (1 .. 10000); 
my %factor_hash = ();
my $number = 1;
my @perfect_numbers = ();
for $number (@numbers) 
{
    #do the factoring in a subroutine
    #store a string such as 1-2-4 for the factors of 4
    $factor_hash{$number} = factor($number);
}

#time to check for perfection
for $number (@numbers)
{
    my $sum_of_factors = 0;
    my @factors = split /-/, $factor_hash{$number};
    for my $factor (@factors)
    {
        $sum_of_factors+=$factor;
    }
    #a number is perfect if it equals half the sum of all factors
    # (because the number itself is a factor)
    if ($number == $sum_of_factors/2) 
    {
        print "$number is perfect\n";
        push @perfect_numbers, $number;
    }
}

sub factor
{
    my $factor_string = "";
    my $number = shift;
    
    for my $i ( 1 .. $number)
    {
        if (($number % $i) == 0)
        {
            $factor_string .= "-$i";
        }
    }
    return $factor_string;
}
#OUTPUT
#6 is perfect
#28 is perfect
#496 is perfect
#8128 is perfect

    [download]

    According to wikipedia the output is correct.

[reply]
[d/l]
      omg, thanks so much D:
[reply]
Re: finding perfect numbers
by toolic (Bishop) on Aug 05, 2010 at 19:45 UTC
[reply]
[d/l]

Back to Seekers of Perl Wisdom