Cod sursa(job #347337)

Utilizator ScriamTertiuc Afanasie Scriam Data 11 septembrie 2009 20:28:37
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
Program P1;
var a : array[1..100000] of integer;
    n,sum : integer;
    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.