Cod sursa(job #244949)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 16 ianuarie 2009 13:17:25
Problema Fractii Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.88 kb
var i,n,j,p,cop,d:longint;
    s:int64;
    t:array[1..100000] of int64;
    e:array[1..100000] of 0..1;
begin
assign(input,'fractii.in'); reset(input);
readln(n);
close(input);
for i:=1 to n do e[i]:=1;
for i:=2 to n do
  if e[i]=1 then begin
    j:=2*i;
    while (j<=n) do
      begin
        e[j]:=0; inc(j,i);
      end;
  end;
s:=0;
for i:=1 to n do
  begin
    if e[i]=1 then t[i]:=i-1
           else
             begin
               d:=2; while i mod d<>0 do inc(d);
               p:=1; cop:=i;
               while cop mod d=0 do
                 begin
                   p:=p*d;
                   cop:=cop div d;
                 end;
               if cop=1 then t[i]:=i-(i div d)
                   else t[i]:=t[p]*t[cop];
             end;
     s:=s+t[i];
  end;
assign(output,'fractii.out'); rewrite(output);
writeln(2*s+1);
close(output);
end.