Cod sursa(job #26991)

Utilizator QbyxEros Lorand Qbyx Data 5 martie 2007 23:13:30
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
var
  p: array[1..1000000] of boolean;
  n, i: longint;
  f: text;
  res: int64;

Procedure Erastostene;
var k, j: longint;
begin
  for k := 2 to n do p[k] := true;
  for  k := 2 to n do
    if p[k] then for j := 2 to (n div k) do p[k * j] := false;
end;

Function Tot(l: longint):longint;
var
  r: real;
  k: longint;
begin
  r := l;
  if p[l] then r := l - 1 else
    for k := 1 to Round(l / 2) do
      If (p[k]) and (l mod k = 0) then r := r * (1 - (1 / k));
  Tot := Round(r);
end;

begin
  Assign(f, 'fractii.in');
  Reset(f);
  ReadLn(f,n);
  Close(f);
  Erastostene;
  res := 0;
  for i := 2 to n do
    res := res + Round(Tot(i));
  res := 1 + 2 * res;
  Assign(f, 'fractii.out');
  ReWrite(f);
  Write(f, res);
  Close(f);
end.