Cod sursa(job #255221)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 8 februarie 2009 21:03:41
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.12 kb
program alex;
var f:text;
    c,p:array[1..1000001]of longint;
    i,k,j,n,x:longint;
    nr,prod,s:int64;
begin
assign(f,'fractii.in');reset(f);
readln(f,n);
close(f);
c[1]:=1;
i:=1;
k:=0;
repeat
i:=i+1;
if c[i]=0 then begin
               k:=k+1;
               p[k]:=i;
               if i<trunc(sqrt(n)) then j:=i*i
                                   else j:=i+i;
               while j<=n do
                     begin
                     c[j]:=1;
                     j:=j+i;
                     end;
               end;
until(i>=n);
assign(f,'fractii.out');rewrite(f);
for i:=2 to n do
    begin
    x:=i;
    j:=1;
    prod:=i;
    while(p[j]*p[j]<=x)and(x>1)do
         begin
         if x mod p[j]=0 then begin
                              prod:=prod div p[j];
                              prod:=prod*(p[j]-1);
                              while x mod p[j]=0 do
                                    x:=x div p[j];
                              end;
         j:=j+1;
         end;
    if x<>1 then prod:=(prod div x)*(x-1);
    s:=s+prod;
    end;
nr:=1+s*2;
writeln(f,nr);
close(f);
end.