Cod sursa(job #114769)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 15 decembrie 2007 18:58:25
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.26 kb
var fi,fo:text;
    nr_div,i,n,x,max,ct,j:longint;
    rez:int64;
    nr:array[1..1000100]of byte;
    m:array[1..1000100]of longint;
function prim(nr:longint):boolean;
var i,vari,k:longint;
begin
  nr_div:=0; prim:=true; vari:=nr; ct:=1;
  for k:=2 to trunc(sqrt(nr)) do
   if vari<>0 then
    begin
     if vari mod k*k=0 then begin ct:=2; prim:=false; exit; end;
     if vari mod k=0 then begin inc(nr_div); vari:=vari div k; end;
    end
   else break;
  if nr_div>0 then prim:=false;
end;
procedure verif(i:longint);
var ok:boolean;
begin
  ok:=prim(i);
  if ok=true then rez:=rez+(m[i]*(m[i]-1) shr 1)
    else
      if nr_div>0 then
        if ct=1 then
          if nr_div and 1 = 1 then rez:=rez+(m[i]*(m[i]-1)) shr 1
                              else rez:=rez-(m[i]*(m[i]-1)) shr 1;
end;
begin
  assign(fi,'pairs.in'); reset(fi);
  assign(fo,'pairs.out'); rewrite(fo);
  readln(fi,n);
  max:=-maxint;
  rez:=0;
  for i:=1 to n do
    begin
      readln(fi,x);
      nr[x]:=1;
      if x>max then max:=x; end;
  for i:=2 to max do
    begin
      for j:=1 to max div i do
         if nr[i*j]=1 then inc(m[i]);
      if (m[i]>0) then verif(i);
    end;
  rez:=n*(n-1) shr 1 - rez;
  writeln(fo,rez);
  close(fi);
  close(fo);
end.