Cod sursa(job #25072)

Utilizator marius21Petcu Marius marius21 Data 4 martie 2007 10:24:35
Problema Puteri Scor 40
Compilator fpc Status done
Runda preONI 2007, Runda 3, Clasa a 10-a Marime 1.79 kb
const prim:array[1..31] of byte =(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127);
var j,s,n,a,b,c,i:longint;
v:array[1..100000,1..3] of byte;
v1:array[1..3] of byte;
ok:boolean;
f,g:text;
procedure ordoneaza(nr:byte);
var x,y,aux:byte;
begin
for x:=1 to nr-1 do
for y:=x+1 to nr do
if v1[x]>v1[y] then begin
aux:=v1[x];
v1[x]:=v1[y];
v1[y]:=aux;
end;
end;
function cmmdc(nr:byte):boolean;
var x:byte;
ok1:boolean;
begin
ok1:=false;
x:=1;
if nr=3 then
while (not ok1) and (prim[x]<=v1[1]) do begin
if (v1[1] mod prim[x]=0) and (v1[2] mod prim[x]=0) and (v1[3] mod prim[x]=0) then ok1:=true;
inc(x);
end;
if nr=2 then
while (not ok1) and (prim[x]<=v1[1]) do begin
if (v1[1] mod prim[x]=0) and (v1[2] mod prim[x]=0) then ok1:=true;
inc(x);
end;
cmmdc:=ok1;
end;
begin
assign(f,'puteri.in');
assign(g,'puteri.out');
reset(f);
rewrite(g);
readln(f,n);
for i:=1 to n do begin
   read(f,v[i,1],v[i,2],v[i,3]);
   for j:=1 to i-1 do begin
      a:=v[i,1]+v[j,1];
      b:=v[i,2]+v[j,2];
      c:=v[i,3]+v[j,3];
      ok:=false;
      if ((a=0) and (b=0)) or ((a=0) and (c=0)) or ((c=0) and (b=0)) then
         ok:=true
      else
      if (a=0) or (b=0) or (c=0) then begin
         if a=0 then begin
               v1[1]:=b;
               v1[2]:=c;
         end;
         if b=0 then begin
               v1[1]:=a;
               v1[2]:=c;
         end;
         if c=0 then begin
               v1[1]:=b;
               v1[2]:=a;
         end;
         ordoneaza(2);
         ok:=cmmdc(2);
      end
      else begin
         v1[1]:=a;
         v1[2]:=b;
         v1[3]:=c;
         ordoneaza(3);
         ok:=cmmdc(3);
      end;
      if ok then inc(s);
   end;
end;
writeln(g,s);
close(f);
close(g);
end.