Cod sursa(job #278033)

Utilizator THE_GAMEAndrei Alexandru THE_GAME Data 12 martie 2009 08:01:22
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.78 kb
program fractii;
var v,fi:array[1..10000]of integer;
    n,nr,j,s,i:integer;
    f,g:text;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);
read(f,n);
for i:=2 to n div 2 do
    if v[i]=0 then
       for j:=2 to n div i do v[i*j]:=i;
for i:=2 to trunc(sqrt(n)) do
    if v[i]=0 then begin
       nr:=i;
       while nr<n do begin
             fi[nr]:=nr-nr div i;
             nr:=nr*i;
       end;
    end;
for i:=2 to n do
    if fi[i]=0 then
       if v[i]=0 then fi[i]:=i-1
                 else begin
                      nr:=i;
                      while nr mod v[i]=0 do nr:=nr div v[i];
                      fi[i]:=fi[nr]*fi[i div nr];
                 end;
for i:=1 to n do s:=s+fi[i];
rewrite(g);
write(g,2*s+1);
close(f);
close(g);
end.