Cod sursa(job #1879260)

Utilizator TonuMiaMaximelaTMaximela TonuMiaMaximela Data 14 februarie 2017 20:10:09
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.14 kb

type ta=array [1..100000] of 0..1;
     ta2=array [1..100000] of int64;
var f:text;
    d,s,n,c,p:int64;
    i,j:longint;
    a:ta;
    t:ta2;
begin
assign(f,'fractii.in');
reset(f);
read(f,n);
close(f);
for i:=2 to n do
    if a[i]=0 then
       for j:=2 to (n div i) do
           a[i*j]:=1;
s:=1;
for i:=1 to n do
              begin
               if a[i]=0 then t[i]:=i-1
                         else
                           begin
                            d:=2;
                            while i mod d<>0 do inc(d);
                            p:=1;
                            c:=i;
                            while c mod d=0 do
                                             begin
                                              c:=c div d;
                                              p:=p*d;
                                             end;
                            if c=1 then t[i]:=i-(i div d)
                                   else t[i]:=t[p]*t[c];
                          end;
               s:=s+t[i];
              end;
assign(f,'fractii.out');
rewrite(f);
write(f,2*suma-1);
close(f);
end.