eduardo challenged me to write the smallest sieve of Erothenes that I could. Here's what I came up with...

/\/\averick 
foreach (1..100) {
        push @_,$_;
        foreach (@_[1..($#_-1)]) {
                pop @_ and last unless ($_[-1] % $_);
        }
}
print join(" ",@_),"\n";

[download]

Replies are listed 'Best First'.
RE: sieve of Eratosthenes
by ase (Monk) on Jul 01, 2000 at 11:49 UTC
    This has been an interesting thread to follow. I played around with a Bit Vector algorithm... going for efficiency at the cost of a little brevity. Here's what I came up with: 
    #!usr/bin/perl -w
use Benchmark;

timethese(100,{
 Adam => sub { 
    @_=(1);
  L:for(2..1000) {
      $i=-@_;        #updated per node 20757 7/13/2000
      while(++$i){   #ditto
          next L if!($_%$_[$i])
      }
      push@_,$_
    }
    #print join "\t", @_;
  },

 Maverick => sub { 
    for(1..1000){
      push@_,$_;
      for(@_[1..$#_-1]){
        pop@_&&last if!($_[-1] %$_)
      }
    }
    #print join "\t", @_;
  },

 Ase => sub {
    $v='1' x 1000;
    for(2..1000){
      next if !vec($v,$_-1,8);
      for($q=$_*2;$q<1001;$q+=$_){
         vec($v,$q-1,8)=0
      }
    }
   #print join "\t",grep {vec($v,$_-1,8)} (1..1000);
  },

});

    [download]

    Here's a table summarizing the data:
    RoutineNIterationsTime
    Adam10001005
    Ase10001002
    Maverick10001002
    Adam10000100203
    Ase1000010021
    Maverick1000010024
    Ase100000100221
    Maverick100000100236
    Benchmark is your friend!

    It seems Mavericks code is only very slightly slower with the benefit of being slightly shorter.

    This was done on a 300 mHz amd K6 running win 98 and perl 5.005_02 (activestate 509) as always your mileage may vary.

    Update 7/13/2000: I modified Adam's code per this node and re-benchmarked accordingly.
    -ase

[reply]
[d/l]
[select]
      Nice algorithm! The idea of using vectors never occured to me.

      I went back and uncomment the print statements to see what kind of overhead the grep might cause. At N=100000 I end up with: 

      Benchmark: timing 100 iterations of Ase, Maverick...
       Ase: 142 wallclock secs (141.93 usr +  0.04 sys = 141.97 CPU)
  Maverick: 166 wallclock secs (166.05 usr +  0.00 sys = 166.05 CPU)

      [download]
      I would have expected us to end up with closer times, but your's ends up being 24 seconds faster? wow. So, I removed the prints and got: 
      Benchmark: timing 100 iterations of Ase, Maverick...
       Ase: 122 wallclock secs (121.11 usr +  0.00 sys = 121.11 CPU)
  Maverick: 164 wallclock secs (164.65 usr +  0.03 sys = 164.68 CPU)

      [download]
      I'm running this on a PII 400, using Red Hat Linux and the stock perl RPM (5.005_03). It would seem that vec is much faster under Linux than under windows.

      Hmmm...I wonder how these benchmark out on other platforms...

      /\/\averick

[reply]
[d/l]
[select]
        I wish I could claim the algorithm for my own, but I can't.. Ironically enough, I got it from "More Programming Pearls" by Jon Bentley (nothing to do with perl as its copyright date is 1988) He deals mostly with awk but I highly recommend it as well as its out of print predecessor "Programming Pearls"... which I was able to obtain a while ago.... good stuff for any programmer.

        I would also be interested in benchmarks on other platforms.
        -ase

[reply]
      In the pursuit of efficiency I have come up with a slightly different implementation: Carl1. In Carl2 I tried to optimize at the expense of a few more characters.

      On my WinNT PIII 800Mhz machine with ActiveState 522 both of these are faster than ase's Bit Vector implementation. 

        Carl1:
    @p=(1);for(2..10000){if(!$n[$_]){push@p,$_;for($k=$_*$_;$k<=10000;
+$n[$k]=1,$k+=$_){}}}

  Carl2:
    @p=(1,2);for($_=3;$_<=10000;$_+=2){if(!$n[$_]){push@p,$_;for($k=$_
+*$_;$k<=10000;$n[$k]=1,$k+=$_){}}}

      [download]
      One thing that I found interesting is that for n less than about 10,000, Carl1 is significantly faster than Carl2. The loop control overhead must be pretty significant.

      Have fun,
      Carl Forde

[reply]
[d/l]
RE: sieve of erothenes
by ferrency (Deacon) on Jul 08, 2000 at 01:01 UTC
    Here is a prime number verifier that Abigail presented at his talk entitled "JAPHs and Other Obscure Signatures" at YAPC 19100. Very clever, very short, but I can't say much for the performance: 
    perl -wle 'print "Prime" if (1 x shift) !~ /^1?$|^(11+?)\1+$/'

    [download]
    This takes a number as a parameter, and checks to see whether it's prime or not. I modified it a bit to stuff @_ with primes, and got this:

    for(1..100){push@_,$_ if (1 x $_) !~ /^1?$|^(11+?)\1+$/}

    [download]
    I think that's shorter, no?
    As I said, I can't claim credit for this! But it's definitely worth noting. There's an explanation of how it works on his talk web site.

    Alan

[reply]
[d/l]
[select]
      Okay, so I went back to Abigail's talk, and discovered that he Doesn't actually explain completely how it works... I was at the talk, and apparently he talked and pointed, but the things he said weren't on the slide. So, I'll attempt to describe How this regexp matches prime numbers only... no promises I'll get it all correct though.

      First, we build a string: 

      1 x $_

      [download]
      This is a string of 1's as long as the number you're testing. Then we test that against the regexp:
      /^1?$|^(11+?)\1+$/

      [download]
      The first half of the alternation just takes care of matching an empty string (the number 0) and a single 1 (the number 1) which are prime. I'll break out the second half for clarity:
      /^(11+?)\1+$/

      [download]
      In the parens, we match 2 or more ones in succession, in a non-greedy fashion. That means, it'll first try the regex matching "11" in the parens, and if the rest of the regex fails, it'll backtrack and try "111" in the parens, and so on. (sounds like a for loop...)

      After the parens, it looks for at least one more occurance of \1, which is what it just captured inside the parens. So, it's basically matching for an integral number of "11"'s in the string, and if that fails, it backtracks and tries matching an integral number of "111"'s in the string, and so on. Because of the anchors, there is no room for extra 1's at the end of the string. And since it needs to match the string of ones twice (once in the parens, and at least one more time after that), if the regex succeeds, you know that the number is divisible by a smaller integer, and is therefore not prime.

      I hope this helps... since it was already described in public at least once, I don't feel bad giving this particular magician's secret away. I'm sorry I don't know who originally wrote the code; I'm not sure if it's Abigail's or not.

      Alan

[reply]
[d/l]
[select]
        Very slick! I've never seen it done like this before. We're not using the same algorithm, but for my own morbid curiosity I benchmarked it against mine and ase's code. I added the 'o' modifier to your regex to speed it up a bit. 
        #!usr/bin/perl -w
use Benchmark;

timethese(100,{ Maverick => 
                sub { 
                        for (1..1000){
                                push @_,$_;
                                for (@_[1..$#_-1]){
                                        pop @_ && last if !($_[-1]%$_)
                                }
                        }
                        #print join "\t", @_;
                },

                Ase => 
                sub {
                        $v='1' x 1000;
                        for(2..1000){
                                next if !vec($v,$_-1,8);
                                for($q=$_*2;$q<1001;$q+=$_){
                                        vec($v,$q-1,8)=0
                                }
                        }
                        #print join "\t",grep {vec($v,$_-1,8)} (1..100
+0);
                },

                Alan =>
                sub {
                        for(1..1000){
                                push @_,$_ if (1 x $_) !~ /^1?$|^(11+?
+)\1+$/o
                        }
                        #print join "\t", @_;
                }
});

        [download]
        and ended up with: 
        Benchmark: timing 100 iterations of Alan, Ase, Maverick...
      Alan: 93 wallclock secs (92.95 usr +  0.00 sys = 92.95 CPU)
       Ase:  1 wallclock secs ( 1.03 usr +  0.00 sys =  1.03 CPU)
  Maverick:  1 wallclock secs ( 1.65 usr +  0.01 sys =  1.66 CPU)

        [download]
        You have the shortest but ase still has the fastest. :)

        This started off being about the seive of "the always mispelled guy", but now I'm curious about other ways of doing this. Perhaps on some rainy afternoon I'll go dig up few more interesting snippets to throw at the monk collective...

        /\/\averick

[reply]
[d/l]
[select]
RE: sieve of erothenes
by Adam (Vicar) on Jul 01, 2000 at 03:05 UTC
    I tried to do it with less, but I could only beat you by a char or two based on spacing. 
    @_=(1);
L:for(2..100)
{ 
   $i=@_;
   while(--$i){next L unless $_ % $_[$i] }
   push @_,$_
}
print join(" ",@_),"\n";

    [download]
    ##########
    My spacing:
    sub Adam () 
{ @_=(1);L:for(2..100){$i=@_;while(--$i){next L unless $_%$_[$i]}push 
+@_,$_} @_ }
sub Maverick ()
{ for(1..100){push @_,$_;for(@_[1..($#_-1)]){pop @_ and last unless $_
+[-1]%$_}} @_ }

    [download]
[reply]
[d/l]
[select]
      I removed and extra set of parens, changed the unless to a if! and compressed out the extra whitespace and got us dead even. 
      sub A { @_=(1);L:for(2..100){$i=@_;while(--$i){next L if!($_%$_[$i])}p
+ush@_,$_} }
sub M { for(1..100){push@_,$_;for(@_[1..$#_-1]){pop@_ and last if!($_[
+-1]%$_)}} }

print join(" ",@_),"\n";

      [download]
      I kept trying to think of how do this with maps and maybe come out with something different, but nothing has come to me yet

      /\/\averick

      ##Update##
      just saw how to squish out a 3 more characters 
      sub A { @_=(1);L:for(2..100){$i=@_;while(--$i){next L if!($_%$_[$i])}p
+ush@_,$_} }
sub M { for(1..100){push@_,$_;for(@_[1..$#_-1]){pop@_&&last if!($_[-1]
+%$_)}} }

      [download]
[reply]
[d/l]
[select]
        You win on the efficiency test too. with n = 100 we are roughly the same time, but as n gets large I get bogged down somewhere. I'm running a test with n = 1000000 on my dual proc, which has been hung for about five minutes now. But based on the out put I've already seen for smaller n's, I suspect that you will slaughter me time wise.

        I don't understand why yours is faster because you use two for loops and I use a while loop the second time, dropping the overhead of making the temp array that foreach generates. Now I'm curious about the efficiencies of the two looping mechanisms...

[reply]
RE: sieve of Erathostenes
by Corion (Patriarch) on Jul 02, 2000 at 02:16 UTC

    Just for the record, the guy was (presumably) greek and was called Erathostenes, but Google refuses to turn up anything resembling a biography or historical references ...

    Update : plaid is of course correct, the guy is spelled Eratosthenes (note the place of theta vs. the place of the tau).

[reply]
      Close, but the spelling of his name I believe was officially 'Eratosthenes'. While 'Erathostenes' does turn up a few matches on google, I believe those matches were all based on misspellings.
[reply]

Back to Cool Uses for Perl