Cod sursa(job #128673)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 27 ianuarie 2008 17:38:39
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.04 kb
program fractii;
type vect = array [1..1000005] of boolean;
var A : vect;
    m,n,i,j,k,S : longint;
    f : text;
    ok : boolean;
begin
assign(f,'fractii.in');
reset(f);
read(f,n);
close(f);


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

m := trunc(sqrt(n));

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


for i := 1 to n do
if A[i] then write(i,' ');


S := 0;


for i := 1 to n do
for j := 1 to n do begin

ok := true;
if i>j then
for k := 2 to j do
if A[k] then if (i mod k=0) and (j mod k=0) then begin
                                                ok := false;
                                                break
                                                end;
if i<j then
for k := 2 to i do
if A[k] then if (i mod k=0) and (j mod k=0) then begin
                                                ok := false;
                                                break
                                                end;
if ok then S := S+1;

end;


write('S=',S);
readln;

end.