Cod sursa(job #109444)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 25 noiembrie 2007 11:06:48
Problema Pairs Scor 20
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasa a 10-a Marime 0.86 kb
var fi,fo:text;
    n,m,i,ct,j,rez:longint;
    nr:array[1..100010] of longint;
function ggt(x1,x2:longint):longint;
var a,b:longint;
begin
     a:=x1; b:=x2;
     if (a and 1=0)and(b and 1=0) then begin ggt:=2; exit; end;
     if a>b then
        if a mod b=0 then begin ggt:=2; exit; end;
     if b>a then
        if b mod a=0 then begin ggt:=2; exit; end;
     if (a+1=b)or(a-1=b) then begin ggt:=1; exit; end;
     while a<>b do
        if a>b then a:=a-b
               else b:=b-a;
     ggt:=a;
end;
begin
     assign(fi,'pairs.in'); reset(fi);
     assign(fo,'pairs.out'); rewrite(fo);
     read(fi,n);
     ct:=0;
     for i:=1 to n do
        begin
             read(fi,nr[i]);
             for j:=i-1 downto 1 do
                if ggt(nr[i],nr[j])=1 then inc(ct);
        end;
     writeln(fo,ct);
     close(fi);
     close(fo);
end.