Cod sursa(job #25263)

Utilizator ProtomanAndrei Purice Protoman Data 4 martie 2007 11:41:35
Problema Puteri Scor 40
Compilator fpc Status done
Runda preONI 2007, Runda 3, Clasa a 10-a Marime 1.13 kb
var a:array[1..100000,1..3] of longint; i,j,nr,r,z,x,y,aux,w,n:longint; f1,f2:text;

procedure cmmdc(q1,q2:longint);
var a,b,c:longint;
begin
a:=q1;
b:=q2;
while b>0 do begin
c:=a mod b;
a:=b;
b:=c;
end;
nr:=a;
end;

begin
        assign(f1,'puteri.in');
        reset(f1);
        assign(f2,'puteri.out');
        rewrite(f2);
        read(f1,n);
        for i:=1 to n do read(f1,a[i,1],a[i,2],a[i,3]);
        for i:=1 to n-1 do
        for j:=i+1 to n do begin
                r:=0;
                x:=a[i,1]+a[j,1];
                y:=a[i,2]+a[j,2];
                z:=a[i,3]+a[j,3];
                if x>z then begin aux:=z; z:=x; x:=aux; end;
                if x>y then begin aux:=y; y:=x; x:=aux; end;
                if y>z then begin aux:=z; z:=y; y:=aux; end;
                if (r=0)and(y=0)then begin inc(w); inc(r); end;
                if (r=0)and(x=0)and(y>1) then begin inc(r); cmmdc(y,z); if nr>1 then inc(w); end;
                if (r=0)and(x>1) then begin r:=1; cmmdc(x,y); cmmdc(nr,z); if nr>1 then inc(w); end;

        end;
        write(f2,w);
        close(f1);
        close(f2);
end.