Cod sursa(job #109460)

Utilizator icetTamas Radu icet Data 25 noiembrie 2007 11:12:15
Problema Pairs Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 11-12 Marime 1.04 kb
 program pairs;
 type vect = array[1..100000] of longint;
      sir = array[1..100000] of longint;
 var a: vect;
     b: sir;
     i,j,k,n,nrp: longint;
     f: text;

 function prim(x: longint): boolean;
 var ok: boolean;
     d: longint;
 begin

   if (x=2) or (x mod 2 <> 0) and (x > 1) then ok:=true
   else ok := false;

   d:=3;
   while (d<=trunc(sqrt(x))) and ok do begin

      if x mod d = 0 then ok := false
      else inc(d,2);

   end;

   prim := ok;
 end;

 begin
    FillChar(b, sizeof(b), false);
    j:=0;
    assign(f,'pairs.in'); reset(f);
      readln(f,n);
      for i:=1 to n do begin
        readln(f,a[i]);
        if prim(a[i]) then begin
           inc(j);
           b[j]:=i;
        end;
      end;
    Close(f);

   nrp:=0;

   for i:=1 to j do begin
     for k:=1 to n do begin
       if (a[k]<>a[b[i]]) and (a[k] mod a[b[i]] <> 0) and (a[k]<>1) then
         inc(nrp);
     end;
     a[b[i]]:=1;
   end;

   assign(f,'pairs.out'); rewrite(f);
     write(f,nrp);
   Close(f);
 end.