Cod sursa(job #223464)

Utilizator SCORPYONHuBBa-BuBBa SCORPYON Data 28 noiembrie 2008 17:21:39
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.99 kb
 type ta=array [1..1000000] of 0..1;
     ta2=array [1..1000000] of int64;      
var f:text;      
    d,suma,n,cop,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;      
suma:=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;      
    cop:=i;      
    while cop mod d=0 do     
          begin     
          cop:=cop div d;      
          p:=p*d;      
          end;      
    if cop=1 then t[i]:=i-(i div d)      
             else t[i]:=t[p]*t[cop];      
    end;      
    suma:=suma+t[i];      
    end;      
assign(f,'fractii.out');rewrite(f);      
write(f,2*suma-1);      
close(f);      
end.