Cod sursa(job #1688981)

Utilizator medicinedoctoralexandru medicinedoctor Data 13 aprilie 2016 20:44:44
Problema Ciurul lui Eratosthenes Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.03 kb
var a:array [1..2000000] of boolean;
n:longint;

procedure prime;
var i,x,y,q:longint;
begin
  i:=trunc(sqrt(n));
  for x:=1 to i do
    for y:=1 to i do
    begin
      q:=4*sqr(x)+sqr(y);
      if (q<=n) and ((q mod 12 = 1) or (q mod 12 =5)) then a[q]:=not a[q];
      q:=q-sqr(x);
      if (q<=n) and (q mod 12 =7) then a[q]:=not a[q];
      q:=q-2*sqr(y);
      if (x>y) and (q<=n) and (q mod 12 = 11) then a[q]:=not a[q];
    end;
  for i:=5 to i do
    if a[i] then
    begin
      x:=sqr(i);
      q:=x;
      while (q<=n) do
      begin
        a[q]:=false;
        q:=q+x;
      end;
    end;
  a[2]:=true;
  a[3]:=true;
end;

function cc:longint;
var i,x:longint;
begin
  for i:=1 to n do
    if a[i] then x:=x+1;
  cc:=x;
end;

procedure lire;
begin
  assign(input,'ciur.in');
  reset(input);
  read(n);
  close(input);
end;

procedure ecrire(x:longint);
begin
  assign(output,'ciur.out');
  rewrite(output);
  write(x);
  close(output);
end;

begin
  lire;
  prime;
  ecrire(cc);
end.