Cod sursa(job #109267)

Utilizator MDanFMI - Dan Moldovan MDan Data 25 noiembrie 2007 09:50:16
Problema Pairs Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 11-12 Marime 0.94 kb
var a:array [1..100000] of longint;
    i,j,aux,auxx,n,max,m,tot:longint;
    f,g:text;
begin
assign (f,'paris.in');
assign (g,'paris.out');
reset(f);
rewrite (g);
readln (f,n);
for i:=1 to n do
readln (f,a[i]);
j:=0;

for i:=1 to n-1 do
    for j:=i+1 to n do
    begin
    aux:=a[i];
    auxx:=a[j];
    while (aux<>auxx) do
          begin
          if aux>auxx
          then
              begin
              if aux mod auxx<>0
              then
              aux:=aux-((aux div auxx)*auxx)
              else
              aux:=aux-(((aux div auxx)-1)*auxx);
              end
          else
              begin
              if auxx mod aux<>0
              then
              auxx:=auxx-((auxx div aux)*aux)
              else
              auxx:=auxx-(((auxx div aux)-1)*aux);
              end;
          end;
    if aux=1
    then
        tot:=tot+1;
    end;

writeln (g,tot);

close(f);
close(g);
end.