Cod sursa(job #52425)

Utilizator MDanFMI - Dan Moldovan MDan Data 18 aprilie 2007 20:48:50
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.68 kb
Var f,g:text;
ok:boolean;
i,k,j,n,saux,s:longint;
a:array [1..16000] of longint;
begin
assign (f,'fractii.in');
assign (g,'fractii.out');
reset(f);
rewrite(g);
readln (f,n);
a[1]:=2;
k:=1;
for i:=2 to n do
begin
ok:=false;
j:=1;
while (ok=false) and (j<=trunc(sqrt(i))) do
begin
j:=j+1;
if i mod j=0
then
ok:=true;
end;
if ok=false
then
    begin
    k:=k+1;
    a[k]:=i;
    end;
end;
s:=s+(2*n)-1;
for i:=2 to n do
begin
j:=1;
ok:=true;
while (a[j]<=i) and (a[j]<>0) do
begin
if i mod a[j]=0
then
saux:=saux+1;
j:=j+1;
end;
if i mod 2=0
then
    saux:=saux+(i div 2)-1;
    saux:=n-saux;
    s:=s+saux;
end;
writeln (g,s);
close(f);
close(g);
end.