Cod sursa(job #223787)

Utilizator andrey932Andrei andrey932 Data 29 noiembrie 2008 13:31:33
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.1 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.