Cod sursa(job #223425)

Utilizator doruletzPetrican Teodor doruletz Data 28 noiembrie 2008 16:49:57
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.88 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.