Cod sursa(job #427487)

Utilizator zseeZabolai Zsolt zsee Data 27 martie 2010 21:42:16
Problema Ciurul lui Eratosthenes Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 kb
program primeknig;
const bitek:array[0..7] of byte = (1,2,4,8,16,32,64,128);
var be,ki:text;
    v:array[1..125000] of byte;
    n,i,j,kl:longint;

function bennevanx( x:longint ):boolean;inline;
var m:byte;
begin
 m:= x and 7;
 x:= x shr 3;
 bennevanx := ((v[x]) and (bitek[m])) <> 0;
end;

procedure berakx( x:longint );inline;
var m:byte;
begin
 m:= x and 7;
 x:= x shr 3;
 if ((v[x]) and (bitek[m])) = 0 then
   begin
    v[x]:= v[x] or bitek[m];
    inc(kl);
   end;
end;

begin
 assign(be,'ciur.in');
 assign(ki,'ciur.out');
 reset(be);
 rewrite(ki);
 readln(be,n);
 i:=3;
 kl:= n div 2 - 1;
 while i*i <= n do
   begin
     j:=i*i;
     while j <= n do
        begin
         if odd(j) then berakx( j shr 1 );
         j:=j+2*i;
        end;
     repeat
       i:=i+2
     until not( bennevanx( i shr 1 ) );
   end;
 writeln(ki,n-kl-1);
 close(ki);
end.