lib/Memoize/t/speed.t

   1 #!/usr/bin/perl
   2
   3 use lib '..';
   4 use Memoize;
   5
   6 if (-e '.fast') {
   7   print "1..0\n";
   8   exit 0;
   9 }
  10 $| = 1;
  11
  12 # If we don't say anything, maybe nobody will notice.
  13 # print STDERR "\nWarning: I'm testing the speedup.  This might take up to thirty seconds.\n                    ";
  14
  15
  16 print "1..6\n";
  17
  18 # This next test finds an example that takes a long time to run, then
  19 # checks to make sure that the run is actually speeded up by memoization.
  20 # In some sense, this is the most essential correctness test in the package.
  21 #
  22 # We do this by running the fib() function with successfily larger
  23 # arguments until we find one that tales at leasrtt $LONG_RUN seconds
  24 # to execute.  Then we memoize fib() and run the same call cagain.  If
  25 # it doesn't produce the same test in less than one-tenth the time,
  26 # something is seriously wrong.
  27 #
  28 # $LONG_RUN is the number of seconds that the function call must last
  29 # in order for the call to be considered sufficiently long.
  30
  31
  32 sub fib {
  33   my $n = shift;
  34   $COUNT++;
  35   return $n if $n < 2;
  36   fib($n-1) + fib($n-2);
  37 }
  38
  39 sub max { $_[0] > $_[1] ?
  40           $_[0] : $_[1]
  41         }
  42
  43 $N = 1;
  44
  45 $ELAPSED = 0;
  46
  47 my $LONG_RUN = 10;
  48
  49 while (1) {
  50   my $start = time;
  51   $COUNT=0;
  52   $RESULT = fib($N);
  53   $ELAPSED = time - $start;
  54   last if $ELAPSED >= $LONG_RUN;
  55   if ($ELAPSED > 1) {
  56       print "# fib($N) took $ELAPSED seconds.\n" if $N % 1 == 0;
  57       # we'd expect that fib(n+1) takes about 1.618 times as long as fib(n)
  58       # so now that we have a longish run, let's estimate the value of $N
  59       # that will get us a sufficiently long run.
  60       $N += 1 + int(log($LONG_RUN/$ELAPSED)/log(1.618));
  61       print "# OK, N=$N ought to do it.\n";
  62       # It's important not to overshoot here because the running time
  63       # is exponential in $N.  If we increase $N too aggressively,
  64       # the user will be forced to wait a very long time.
  65   } else {
  66       $N++;
  67   }
  68 }
  69
  70 print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n";
  71 print "# Total calls: $COUNT.\n";
  72
  73 &memoize('fib');
  74
  75 $COUNT=0;
  76 $start = time;
  77 $RESULT2 = fib($N);
  78 $ELAPSED2 = time - $start + .001; # prevent division by 0 errors
  79
  80 print (($RESULT == $RESULT2) ? "ok 1\n" : "not ok 1\n");
  81 # If it's not ten times as fast, something is seriously wrong.
  82 print (($ELAPSED/$ELAPSED2 > 10) ? "ok 2\n" : "not ok 2\n");
  83 # If it called the function more than $N times, it wasn't memoized properly
  84 print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n");
  85
  86 # Do it again. Should be even faster this time.
  87 $COUNT = 0;
  88 $start = time;
  89 $RESULT2 = fib($N);
  90 $ELAPSED2 = time - $start + .001; # prevent division by 0 errors
  91
  92 print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
  93 print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
  94 # This time it shouldn't have called the function at all.
  95 print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");