Cod sursa(job #44724)

Utilizator silvia_the_bestSilvia Pripoae silvia_the_best Data 31 martie 2007 17:46:42
Problema Fractii Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.09 kb
var n,i,s:longint;
    f,g:text;
function euler(x:longint):longint;
var p,i,j,z:longint;
    b:boolean;
begin
     z:=0;
     p:=x;
     if x mod 2=0 then begin
        p:=p div 2;
        z:=z+1;
     end;
     if x=1 then p:=1
     else if x=2 then p:=1
     else if x=3 then p:=2
     else if x=4 then p:=2
     else if x=5 then p:=4
     else begin
          for i:=3 to trunc(x div 2)+1 do
              if x mod i=0 then begin
                 z:=z+1;
                 j:=1;
                 b:=true;
                 while (j<i-1) and (b=true) do begin
                       j:=j+1;
                       if i mod j=0 then b:=false;
                 end;
                 if b=true then p:=p*(i-1) div i;
              end;
          if z=0 then p:=p*(x-1) div x;
     end;
     euler:=p;
end;
begin
     assign(f,'fractii.in');
     reset(f);
     readln(f,n);
     close(f);
     for i:=1 to n do s:=s+euler(i)*2;
     assign(g,'fractii.out');
     rewrite(g);
     writeln(g,s-1);
     close(g);
     {readln(n);
     writeln(euler(n));
     readln;}

end.