Cod sursa(job #13380)

Utilizator pauldbPaul-Dan Baltescu pauldb Data 6 februarie 2007 14:26:48
Problema Fractii Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.59 kb
type sir=array[1..10000] of longint;
var n,s:longint;
    a:sir;
procedure cit;
var f:text;
begin
  assign(f,'fractii.in');reset(f);
  readln(f,n);
  close(f);
end;
procedure solve;
var i,j:longint;
begin
  for i:=2 to n do a[i]:=i-1;
  for i:=1 to n div 2 do
    begin
      j:=2*i;
      while j<=n do
        begin
          a[j]:=a[j]-a[i];
          j:=j+i;
        end;
    end;
  for i:=2 to n do s:=s+a[i];
  s:=s*2+1;
end;
procedure tip;
var f:text;
begin
  assign(f,'fractii.out');rewrite(f);
  writeln(f,s);
  close(f);
end;
begin
  cit;
  solve;
  tip;
end.