in reply to Factorial algorithm execution time

Since multiplication is commutative, you can limit the size of numbers and thus vastly accelerate this function by multiplying the next biggest with the next smallest factor in turn: rather than calculate 1*(2*(3*(4*5))), you calculate ((1*5)*3)*(2*4): 
1 * 2 * 3 * 4 * 5 =
|   |       |   |
|   +-------+   |
+---------------+

5 * 8 * 3 =
|       |
+-------+

15 * 8 =

120
See fact7. 
#!/usr/bin/perl -w
use strict;
use Benchmark;
use Math::BigInt;

sub fact1 {
    my $n = Math::BigInt->new(shift);
    return 1 unless $n->bcmp(0);
    return $n->bmul(fact1($n->bsub(1)));
}

sub fact4 {
    my $n = Math::BigInt->new(1);
    foreach my $i (map Math::BigInt->new($_), 1..shift) {
        $n = Math::BigInt->new($i->bmul($n));
    }
    return $n;
}

sub fact7 {
    my @factor = map Math::BigInt->new($_), (1 .. shift);
    while(@factor > 1) {
        my @pair = splice @factor, 1 + $#factor / 2;
        $_ = $_ * pop @pair for @factor[0..$#pair];
    }
    return shift @factor;
}

my $fact = shift || 100;

my ($f1, $f4, $f7) = (fact1($fact), fact4($fact), fact7($fact));

die "something's broke" if grep $_ != $f1, ($f4, $f7);

timethese(shift || 10, {
    f1 => sub { fact1($fact) },
    f4 => sub { fact4($fact) },
    f7 => sub { fact7($fact) },
});
__END__

$ fact 600 5
Deep recursion on subroutine "main::fact1" at fact line 9.
Benchmark: timing 5 iterations of f1, f4, f7...
Deep recursion on subroutine "main::fact1" at fact line 9.
Deep recursion on subroutine "main::fact1" at fact line 9.
Deep recursion on subroutine "main::fact1" at fact line 9.
Deep recursion on subroutine "main::fact1" at fact line 9.
Deep recursion on subroutine "main::fact1" at fact line 9.
        f1: 17 wallclock secs (17.09 usr +  0.10 sys = 17.19 CPU) @  0
+.29/s (n=5)
        f4: 15 wallclock secs (15.09 usr +  0.06 sys = 15.15 CPU) @  0
+.33/s (n=5)
        f7:  4 wallclock secs ( 3.99 usr +  0.04 sys =  4.03 CPU) @  1
+.24/s (n=5)

[download]
The difference is negligible for small numbers, but quickly grows to significant magnitude.

Makeshifts last the longest.

Replies are listed 'Best First'.
Re: Re: Factorial algorithm execution time
by gri6507 (Deacon) on Oct 18, 2002 at 17:31 UTC
    I thought about this one also. But your implementation can be improved still. Let's look at 6!:

    2 * 3 * 4 * 5 * 6 =
|   |       |   |
|   +-------+   |
+---------------+

4 * 12 * 15 =
|         |
+---------+

12 * 60 =

120

    [download]
    There are a couple of changes. First, there is no need to multiply by 1. The answer is not going to change :-). Second, you are correct in saying that it's best to multiply the smallest number by the largest first. So, in this case, the left over "4" from the first step should be the first number in the second step. These are implemented in fact8(). If you run it, you'll see that it run's just abit faster.

    sub fact8{
  #divide and conquer without recursion
  my @N = (2 .. shift);
  my @M;
  my $tmp;
  while ($#N){
    while(@N){
      $tmp = pop(@N);
      if (($_ = shift(@N))){push(@M,Math::BigInt->new($tmp)->bmul($_))
+}
      else {unshift(@M,$tmp)}
    }
    while(@M){
      $tmp = pop(@M);
      if (($_ = shift(@M))){push(@N,Math::BigInt->new($tmp)->bmul($_))
+}
      else {unshift(@N,$tmp)}
    }
  }
  return @N;
}

perl fact.pl 5000
Method 8 (new func): 28 wallclock secs (28.65 usr +  0.00 sys = 28.65 
+CPU)
Method 7 (your func): 30 wallclock secs (29.06 usr +  0.00 sys = 29.06
+ CPU)

    [download]
[reply]
[d/l]
[select]
      You're right. But why so much work? A trivial modification to my code will do that. 
      sub fact7b {
    my @factor = map Math::BigInt->new($_), (2 .. shift);
    while(@factor > 1) {
        my @pair = splice @factor, 0, @factor / 2;
        $_ = $_ * pop @pair for @factor[0..$#pair];
    }
    return shift @factor;
}

      [download]
      Update: doh, fixed overly clever, broken code. (s{1 + $#factor / 2}{@factor / 2})

      Makeshifts last the longest.

[reply]
[d/l]
        Did you test that code?
[reply]

In Section Seekers of Perl Wisdom