Cod sursa(job #200822)

Utilizator theratmantheratman theratman Data 26 iulie 2008 19:25:15
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.8 kb
var v,a:array[1..1000000] of longint;
    n,i,j,t:longint;
    k:int64;
    f,g:text;
procedure z(nr,poz:longint);
 var p:longint;
 begin
 p:=1;
 while v[poz] mod nr=0 do begin
  v[poz]:=v[poz] div nr;
  p:=p*nr;
 end;
 if p<>1 then
  d[poz]:=d[poz]*(p div nr)*(nr-1);
 end;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
read(f,n);
k:=0;
if n=1 then write(f,1)
 else begin
  for i:=2 to n do begin a[i]:=1; v[i]:=i; end;
  t:=n shr 1;
  i:=2;
  while i<=t do begin
   if v[i]>1 then begin
    a[i]:=i-1;
    j:=i shl 1;
    while j<=n do begin
     z(i,j);
     inc(j,i);
    end;
    v[i]:=1;
   end;
  inc(i);
 end;
 for j:=i to n do if v[j]>1 then a[j]:=j-1;
end;
for i:=2 to n do inc(k,a[i]);
writeln(g,k shl 1+1);
close(f);
close(g);
end.