Cod sursa(job #14922)

Utilizator stoikStoica George Cristian stoik Data 10 februarie 2007 11:28:34
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.02 kb
var n:longint;
v:array[1..200000] of longint;
a:array[1..500000] of 0..1;
nrf:longint;
f,g:text;

procedure eratostene;
var i,j:integer;
begin
fillchar(a,sizeof(a),1);
for i:=2 to n do
    if a[i]=1 then
       for j:=2 to n div i do
          a[i*j]:=0;
j:=0;
for i:=2 to n do
    if a[i]=1 then
       begin
       inc(j);
       v[j]:=i;
       end;
end;

function nrv(x:longint):longint;
var nr,i,d,t,p,q:longint;
begin
q:=1;
nr:=1;
while x<>1 do
    begin
    t:=0; p:=1;
      d:=v[q];
      while x mod d=0 do
            begin
            inc(t);
            x:=x div d;
            p:=p*d;
            end;
      if t<>0 then
        if t=1 then nr:=nr*(d-1)
        else
            nr:=nr*(p-p div d);
     inc(q);
    end;
nrv:=nr;
end;

procedure solve;
var i:longint;
begin
nrf:=1;
for i:=2 to n do
    nrf:=nrf+2*nrv(i);
writeln(g,nrf);
end;

begin
assign(f,'fractii.in');reset(f);
readln(f,n);
assign(g,'fractii.out');rewrite(g);
eratostene;
solve;
close(g);
end.