Cod sursa(job #116895)

Utilizator iri.bIrina B iri.b Data 19 decembrie 2007 19:43:52
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.47 kb
var f,g:text; n,c:longint; i,j:byte;
    v:array[1..100000]of integer;
begin
assign(f,'pairs.in');reset(f);
assign(g,'pairs.out');rewrite(g);
readln(f,n);  c:=0;
for i:=1 to n do readln(f,v[i]);
for i:=1 to n-1 do
for j:=1+i to n do
 if v[i]<>v[j] then begin
        while v[i]<>v[j] do
                if v[i]>v[j] then v[i]:=v[i]-v[j]
                             else v[j]:=v[j]-v[i];
        if v[i]=1 then c:=c+1;
 end;
write(g,c);
close(f);close(g);
end.