Cod sursa(job #347339)

Utilizator ScriamTertiuc Afanasie Scriam Data 11 septembrie 2009 20:31:38
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
Program P1;
var a : array[1..1000000] of longint;
    n,sum : longint;
    f,g : text;

{Function calc(n : integer) : integer;
var i,j : integer;
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
write(a[i],' ');
end;}


Procedure rez;

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 sum := sum + a[i];

sum := sum*2 + 1;

end;



begin
assign(f,'fractii.in');     assign(g,'fractii.out');
reset(f);                   rewrite(g);
readln(f,n);
rez;
writeln(g,sum);
close(f);
close(g);
end.