Cod sursa(job #262828)

Utilizator Teodor94Teodor Plop Teodor94 Data 19 februarie 2009 18:07:14
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.54 kb
var f,g:text;
    n,i,nr,j,r: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
          while a[j]<>0 do
            begin
              r:=a[i] mod a[j];
              a[i]:=a[j];
              a[j]:=r;
            end;
          if a[i]=1 then inc(nr);
        end;
  writeln(g,nr);
  close(f); close(g);
end.