Pagini recente » Cod sursa (job #1368857) | Cod sursa (job #18958) | Cod sursa (job #1117421) | Cod sursa (job #1821029) | Cod sursa (job #388926)
Cod sursa(job #388926)
program pascal;
type
pcelula = ^celula;
celula = record
info : longint;
leg : pcelula;
end;
var
f:text;
v:array[1..1000000] of byte;
n,calcul:longint;
L,p:pcelula;
procedure prime;
var
i,j:longint;
temp:pcelula;
begin
new(L);
L^.leg:=nil;
p:=L;
for i:=1 to n do
v[i]:=1;
for i:=2 to trunc(sqrt(n)) do
if v[i] = 1 then begin
new(temp);
temp^.leg:=nil;
temp^.info:=i;
p^.leg:=temp;
p:=temp;
for j:=2 to n div i do
v[j*i]:=0;
end;
for i:=trunc(sqrt(n)) to n div 2 do
if v[i]=1 then begin
new(temp);
temp^.leg:=nil;
temp^.info:=i;
p^.leg:=temp;
p:=temp;
end;
end;
function rid_p(a,b:longint):longint;
{functie de ridicare la puterea b a numarului a}
var
t:integer;
put:longint;
begin
put:=1;
for t:=1 to b do
put:=put*a;
rid_p:=put;
end;
procedure rezultat;
var
i,j,fi,x,putere:longint;
begin
calcul:=1;
for i:=2 to n do begin
x:=i;
fi:=1;
p:=L^.leg;
while (p<>NIL) and (p^.info <= i div 2) do begin
j:=p^.info;
if x=1 then break
else
if x mod j = 0 then begin
putere:=0;
while (x mod j = 0) and (x<>1) do begin
inc(putere);
x:=x div j;
end;
fi:=fi * (j-1)*rid_p(j,putere-1);
end;
p:=p^.leg;
end;
if x<>1 then begin
putere:=0;
while (x mod i = 0) and (x<>1) do begin
inc(putere);
x:=x div i;
end;
fi:=fi * (i-1)*rid_p(i,putere-1);
end;
calcul:=calcul+fi;
end;
end;
begin
assign(f,'fractii.in');
reset(f);
read(f,n);
close(f);
prime;
rezultat;
assign(f,'fractii.out');
rewrite(f);
write(f,calcul*2-1);
close(f);
end.