Cod sursa(job #227050)

Utilizator delaremosPopa Mares delaremos Data 3 decembrie 2008 16:27:05
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.18 kb
   1. type ta=array [1..1000000] of 0..1;  
   2.      ta2=array [1..1000000] of int64;     
   3. var f:text;     
   4.     d,suma,n,cop,p:int64;     
   5.     i,j:longint;     
   6.     a:ta;     
   7.     t:ta2;     
   8. begin    
   9. assign(f,'fractii.in');reset(f);     
  10. read(f,n);     
  11. close(f);     
  12. for i:=2 to n do    
  13.     if a[i]=0 then    
  14.        for j:=2 to (n div i) do    
  15.            a[i*j]:=1;     
  16. suma:=1;     
  17. for i:=1 to n do    
  18.     begin    
  19.     if a[i]=0 then t[i]:=i-1    
  20.               else    
  21.     begin    
  22.     d:=2;     
  23.     while i mod d<>0 do    
  24.           inc(d);     
  25.     p:=1;     
  26.     cop:=i;     
  27.     while cop mod d=0 do    
  28.           begin    
  29.           cop:=cop div d;     
  30.           p:=p*d;     
  31.           end;     
  32.     if cop=1 then t[i]:=i-(i div d)     
  33.              else t[i]:=t[p]*t[cop];     
  34.     end;     
  35.     suma:=suma+t[i];     
  36.     end;     
  37. assign(f,'fractii.out');rewrite(f);     
  38. write(f,2*suma-1);     
  39. close(f);     
  40. end.