Cod sursa(job #151629)

Utilizator ghitza_2000Stefan Gheorghe ghitza_2000 Data 8 martie 2008 14:29:47
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.89 kb
var a,i,n,S,j,ct,r,i1,j1:longint;
    f,g:text;
    c:array[1..30000] of byte;
begin
assign(f,'fractii.in'); reset(f);
readln(f,n); close(f);  S:=1;
for i:=2 to n do
begin
S:=S+2;
if c[i]=0 then begin
               S:=S+2*(i-2);
               j:=2*i;
               while j<=n do
                begin
               c[j]:=1;
               j:=j+i;
                end;
               end;
if c[i]=1 then begin
                 ct:=0;
               for j:=2 to i-1 do
               begin
               j1:=j; i1:=i;
               r:=i1 mod j1;
               while r>0 do
               begin
               i1:=j1;
               j1:=r;
               r:=i1 mod j1;
               end;
                     if j1>1 then inc(ct);
               end;
               S:=S+2*(i-2-ct);
               end;
end;
assign(g,'fractii.out'); rewrite(g);
writeln(g,s);
close(g);
end.