Cod sursa(job #109388)

Utilizator Sramos4Szoverfi Balazs Sramos4 Data 25 noiembrie 2007 10:40:06
Problema Pairs Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 11-12 Marime 0.62 kb
var x,y,k,n,i,j,z,a:integer;
p:boolean;
t: array [1..100] of longint;
f,g:text;
Begin
assign(f,'pairs.in');reset(f);
assign(g,'pairs.out');rewrite(g);
read(f,n);z:=0;
for i:=1 to n do
read(f,t[i]);
for i:=1 to n-1 do
 for j:=i+1 to n do begin
  x:=t[i];y:=t[j];k:=2;p:=true;
  if x>y then a:=x
         else if y>x then a:=y;
  if x<>y then repeat
                 if (x mod k=0) and (y mod k=0) then p:=false
                                                else inc(k);
               until (k=a) or (p=false)
               else p:=false;
  if p then inc(z);
  end;
  write(g,z);
  close(g);close(f);
end.