Cod sursa(job #44423)

Utilizator alex_dincaDinca Alexandru-Nicolae - UPB alex_dinca Data 31 martie 2007 12:58:24
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
var a:array[1..100000,1..100000] of 0..1;
    i,j,k,n,x,nr,nrm:longint;
    v:array[1..50000] of longint;
    f:text;
function prim(x:integer):boolean;
var d:longint;
begin
d:=2;prim:=true;
while(d<=x div 2) do begin
     if x mod d = 0 then begin
        prim:=false;
        nr:=nr+1;
        v[nr]:=d;
        end;
     d:=d+1;
     end;
end;


procedure eprim;
begin
for j:=1 to n do a[i,j]:=1;
k:=1;
while (k<=n) do begin
      a[i,i*k]:=0;
      k:=k+1;
      end;
end;

procedure nueprim;
begin
for j:=1 to n do a[i,j]:=1;
for j:=1 to nr do
    for x:=1 to n do
        a[i,x]:=a[i,x] and a[v[j],x] ;

end;

procedure cauta;
begin
nrm:=n;
for i:=2 to n do begin
    nr:=0;
    if prim(i) then eprim
    else nueprim;
    for j:=1 to n do if a[i,j]=1 then inc(nrm);
    end;
end;


begin
assign(f,'fractii.in');reset(f);
readln(f,n);
close(f);
cauta;
assign(f,'fractii.out');rewrite(f);
writeln(f,nrm);
close(f);
end.