Cod sursa(job #301142)

Utilizator cristinabCristina Brinza cristinab Data 7 aprilie 2009 22:50:38
Problema Pairs Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var m:array[1..100000] of longint;
    nr:int64;
    n:longint;

procedure citire;
var i:longint;
    f:text;
begin
assign(f,'pairs.in'); reset(f);
readln(f,n);
for i:=1 to n do readln(f,m[i]);
close(f);
end;

function cmmdc(a,b:longint):longint;
var r:longint;
begin

while b<>0 do
 begin
 r:=a mod b;
 a:=b;
 b:=r;
 end;

cmmdc:=a;
end;

procedure rezolvare;
var i,j:longint;
begin
for i:=1 to n-1 do
    for j:=i+1 to n do
        if cmmdc(m[i],m[j])=1 then inc(nr);
end;

procedure afisare;
var g:text;
begin
assign(g,'pairs.out'); rewrite(g);
writeln(g,nr);
close(g);
end;

begin
citire;
rezolvare;
afisare;
end.