Cod sursa(job #575)

Utilizator kimhioCobarzan Petrut kimhio Data 11 decembrie 2006 15:58:38
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.79 kb
program hio;
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 {pp}
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.