Cod sursa(job #111666)

Utilizator nashnash mit nash Data 1 decembrie 2007 17:32:32
Problema Pairs Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.46 kb
var i,n,j,x,y,k:longint;
    a:array[1..100000] of longint;
    f,g:text;

begin

 assign(f,'pairs.in');
 reset(f);
 readln(f,n);

 for i:=1 to n do
  readln(f,a[i]);
 close(f);

 k:=0;
 for i:=1 to n-1 do
  for j:=i to n do
   if a[i]<>a[j] then begin
    x:=a[i];
    y:=a[j];
    while x<>y do
     if x>y then x:=x-y
      else y:=y-x;
    if x=1 then inc(k);
    end;

 assign(g,'pairs.out');
 rewrite(g);
 write(g,k);
 close(g);

end.