Cod sursa(job #12888)

Utilizator marius21Petcu Marius marius21 Data 5 februarie 2007 10:17:53
Problema Fractii Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.02 kb
var a:array[1..1000000]of boolean;
m:int64;
x,k,nrr,i,j,n,nr:longint;
ok:boolean;
f,g:text;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);
rewrite(g);
read(f,n);
nr:=n-1;
for i:=2 to n do begin
        x:=i;
        j:=1;
        ok:=false;
        nrr:=n-i;
        while x>1 do begin
                inc(j);
                if x mod j=0 then begin
                        x:=x div j;
                        if not ok then begin
                                for k:=i div j+1 to n div j  do
                                if not  a[k*j] then begin
                                        dec(nrr);
                                        a[k*j]:=true;
                                end
                        end;
                        dec(j);
                        ok:=true;
                end
                else ok:=false;
        end;
        nr:=nr+nrr;
        for k:=i+1 to n do if a[k] then a[k]:=false;
end;
nr:=nr*2+1;
writeln(g,nr);
close(f);
close(g);
end.