Cod sursa(job #159481)

Utilizator SILVER_BOY22Dalalau Alexandru SILVER_BOY22 Data 14 martie 2008 10:23:19
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.13 kb
program pairs;
type vector=array[1..100000] of 1..1000000;
var v:vector;
    i,a,b,r,n,x,j:longint;
    f,g:text;
    ciur:vector;
begin
     assign(f,'pairs.in');
     assign(g,'pairs.out');
     rewrite(g);
     reset(f);
     read(f,n);
     for i:= 1 to n do
         read(f,v[i]);
     x:=0;
     for i:=1 to n do
      ciur[i]:=1;
     for i:=2 to n div 2 do
       for j:=2 to n div i do
            ciur[i*j]:=0;

     for i:=1 to n do
       for j:=i+1 to n do
       begin
                begin
                     a:=v[i];
                     b:=v[j];
                     if (a mod 2=0) and (b mod 2=0) then x:=x
                     else
                         if ciur[a]=1 and ciur[b]=1 then x:=x+1
                         else
                         begin
                          repeat
                           r:=a mod b;
                           a:=b;
                           b:=r;
                          until r=0;
                          if a=1 then x:=x+1;
                         end;
           end;
       end;
     write(g,x);
     close(f);
     close(g);
end.