Cod sursa(job #262821)

Utilizator Teodor94Teodor Plop Teodor94 Data 19 februarie 2009 18:00:25
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.58 kb
var f,g:text;
    nr,k,min,i,j,c,n:longint;
    a:array[0..100000] of 0..1000000;
begin
  assign(f,'pairs.in'); reset(f);
  assign(g,'pairs.out'); rewrite(g);
  read(f,n);
  for i:=1 to n do
    read(f,a[i]);
  nr:=0;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[i]<>a[j] then
        begin
          min:=a[i];
          if a[j]<a[i] then min:=a[j];
          c:=1;
          for k:=min downto 2 do
            if (a[i] mod k=0) and (a[j] mod k=0) then begin c:=k; break; end;
          if c=1 then inc(nr);
        end;
  writeln(g,nr);
  close(f); close(g);
end.