Cod sursa(job #109713)

Utilizator runnaway90Oprescu Radu Constantin runnaway90 Data 25 noiembrie 2007 12:32:16
Problema Pairs Scor 20
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasa a 10-a Marime 1.11 kb
var f:text;
        n,i,j,nr:longint;
        a:Array[0..100000]of longint;

function cmmdc(x,y:longint):longint;
var k:integer;
        r:longint;
begin
        k:=0;
        while ((x and 1)=0)and((y and 1)=0) do
        begin
                x:=x div 2;
                y:=y div 2;
                inc(k);
                break;
        end;
        if k=0 then
        begin
                while y>0 do
                begin
                        r:=x mod y;
                        x:=y;
                        y:=r;
                end;
                cmmdc:=x shl k;
        end
        else
                cmmdc:=2;
end;

begin
        assign(f,'pairs.in');
        reset(f);
                reaDln(f,n);
                for i:=1 to n do
                        reaD(f,a[i]);
        close(f);
        for i:=1 to n do
        for j:=i+1 to n do
        if a[i]<>a[j] then
        begin
                if cmmdc(a[i],a[j])=1 then
                        inc(nr);
        end;
        assign(f,'pairs.out');
        rewritE(f);
                write(f,nr);
        close(f);
end.