Cod sursa(job #109544)

Utilizator paulfFrunza Paul paulf Data 25 noiembrie 2007 11:41:50
Problema Pairs Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasa a 10-a Marime 0.87 kb
type pair=record
     desc:array[0..1000]of byte;
     end;

var k,l,p,i,j,n:longint;
    f,g:text;
    ok:boolean;
    a:array[1..100000] of longint;
    b:array[1..100000] of pair;

begin
assign(f,'pairs.in');
assign(g,'pairs.out');
reset(f);
rewrite(g);
readln(f,n);

for i:=1 to n do begin

   readln(f,a[i]);

   if a[i]=2 then begin inc(b[i].desc[0]); b[i].desc[b[i].desc[0]]:=2; end
   else
   for j:=2 to round(a[i] div 2) do
   if a[i] mod j=0 then begin inc(b[i].desc[0]); b[i].desc[b[i].desc[0]]:=j; end;

end;

for i:=1 to n-1 do
for j:=i+1 to n do begin
ok:=false;
    for k:=1 to b[i].desc[0] do begin
       for l:=1 to b[j].desc[0] do begin
       if b[i].desc[k]=b[j].desc[l] then begin ok:=true; break; end;

       end;
    if ok then break;

    end;

if not(ok) then inc(p);

end;
write(g,p);
close(f);
close(g);

end.