Cod sursa(job #26892)

Utilizator QbyxEros Lorand Qbyx Data 5 martie 2007 22:22:04
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.75 kb
program Fractii;
var
  p: array[1..1000000] of boolean;
  n, k, i: longint;
  f: text;
  result: int64;

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

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

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