Cod sursa(job #175272)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 9 aprilie 2008 19:55:50
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.94 kb
program fratii;
var n,S,Sp,i,j,k,l : longint;
    f,g : text;
    A,B,C : array [1..1000000] of boolean;
begin
assign(f,'fractii.in');
reset(f);
assign(g,'fractii.out');
rewrite(g);

read(f,n);

for i := 1 to n do
A[i] := true;
B := A;

for i := 2 to n do
if A[i] then for j := 2 to n div i do A[i*j] := false;



S := n;

for i := 2 to n do begin

Sp := n;
k := i;
C  := B;

if A[i] then Sp := n-n div i
else
for j := 2 to i do
if A[j] then
            if k mod j=0 then begin
                              while k mod j = 0 do k := k div j;

                              for l := 1 to n div j do
                              if C[l*j] then begin
                                           C[l*j] := false;
                                           Sp := Sp-1;
                                           end;
                              end;

S := S+Sp;


end;


write(g,S);

close(f);
close(g);

end.