Cod sursa(job #109518)

Utilizator al3csutzuSirbu Alexandru al3csutzu Data 25 noiembrie 2007 11:34:12
Problema Pairs Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 11-12 Marime 0.69 kb
program pairs;
var a:array[1..100000] of longint;
k,n,i,j,rez,min:longint;
f,g:text;
prime:boolean;
begin
  assign(f,'pairs.in'); assign(g,'pairs.out');
  reset(f); rewrite(g);
  read(f,n);
  for i:=1 to n do read(f,a[i]);
  rez:=n*(n-1) div 2;
  for k:=1 to n-1 do
  for j:=k+1 to n do
  begin
    prime:=true;
    if a[k]>a[j] then min:=a[j] else min:=a[k];
    i:=3;
    if (a[j] mod 2=0) and (a[k] mod 2=0) then prime:=false
    else
    while (i<=min div 2) do
    begin
      if (a[k] mod i=0) and (a[j] mod i=0) then begin prime:=false; i:=(min div 2)+1; end;
      i:=i+2;
    end;
    if not prime then rez:=rez-1;
  end;
  write(g,rez);
  close(f); close(g);
end.