Cod sursa(job #134027)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 10 februarie 2008 13:14:12
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.94 kb
program sum;
type lint = 0..1000000;
var i,n,j,S : lint;
    f,g : text;
    A : array [2..1000000] of boolean;

procedure init;
begin
for i := 2 to 1000000 do
A[i] := true;

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

end;

function min(a,b:lint):lint;
begin
if a>b then min := b
        else min := a;
end;

function prim(x,y:lint):boolean;
var l : longint;
    ok : boolean;
begin
ok := true;

for l := 2 to min(x,y) do
if A[l] then if (x mod l = 0) and (y mod l = 0) then begin
                                ok := false;
                                break;
                                end;



prim := ok;

end;

begin

init;

assign(f,'fractii.in');
reset(f);

readln(f,n);

close(f);


S := 0;


for i := 1 to n do
for j := 1 to n do
if prim(i,j) then S := S+1;


assign(f,'fractii.out');
rewrite(f);

writeln(f,S);

close(f);

end.