Cod sursa(job #114780)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 15 decembrie 2007 20:54:27
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.73 kb
type vector=array[1..211]of integer;
const prime:vector=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,
197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,
457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,
739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997,1009,1013,1019,1021,
1031,1033,1039,1049,1051,1061,1063,1069,1087,1091,1093,1097,1103,1109,1117,1123,1129,1151,1153,1163,1171,1181,1187,1193,1201,1213,1217,1223,1229,1231,1237,1249,1259,1277,1279,1283,1289,1291,1297);
var fi,fo:text;
    nr_div,i,n,x,max,ct,j:longint;
    rez:int64;
    nr1:array[1..1000100]of byte;
    m:array[1..1000100]of longint;
function cauta(nr:longint):boolean;
var st,dr,mij:longint;
begin
  st:=1; dr:=168; cauta:=false;
  while st<=dr do
    begin
      mij:=(st + dr) div 2;
      if prime[mij]=nr then begin cauta:=true; exit; end
        else
          if prime[mij]>nr then dr:=mij-1
            else st:=mij+1;
    end;
end;
function prim(nr:longint):boolean;
var i,vari,k:longint;
begin
  nr_div:=0; prim:=true; vari:=nr; ct:=1;
  if cauta(nr)=true then exit;
  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
       if (vari div k <> 2)and((vari div k) and 1 = 1) then
        if cauta(vari div k)=true then
          begin
            inc(nr_div,2);
            prim:=false;
            exit; end;
        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);
      nr1[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 nr1[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.