Cod sursa(job #195405)

Utilizator theratmantheratman theratman Data 18 iunie 2008 13:15:49
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.75 kb
var f,g:text;
    s:int64;
    l,n,x,i:longint;
    b:array[1..1000000]of word;
    a:array[1..1000000]of boolean;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
read(f,n);
l:=trunc(sqrt(n));
for i:=1 to n do
    a[i]:=true;
for i:=2 to l do begin
    x:=i;
    while x+i<=n do begin
          inc(x,i);
          a[x]:=false;
          end;
    end;
for i:=2 to n do b[i]:=1;
for i:=2 to n do begin
    x:=i;
    if a[i]=true then begin
       b[i]:=n-(n div i);
       while x+i<=n do begin
             inc(x,i);
             if b[x]<>0 then inc(b[x]);
             b[x]:=b[i]+1-b[x];
             end;
       end;
    end;
s:=n;
for i:=2 to n do inc(s,b[i]);
writeln(g,s);
close(f);
close(g);
end.