Cod sursa(job #122697)

Utilizator StigmaSimina Pitur Stigma Data 13 ianuarie 2008 14:50:30
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.67 kb
program pairs;
var m:array[1..100 * 1000] of longint;
x:array[1..1000* 1000] of longint;
f,g:text;
k,max,n,fp,i,p,res:longint;
{$m 16384}

function prim(a:longint):boolean;
var d:longint;
sw:boolean;
b:longint;
begin
sw:=true;
d:=2;
b:=a div 2;
while (d<=b) and sw do
if a mod d=0 then sw:=false
else d:=d+1;
prim:=sw;
end;

function factori(a:longint):integer;
var d,nr:integer; sw:boolean;
begin
d:=2;
nr:=0;

while a>1 do
begin
sw:=prim(d);
while sw=false do
begin
d:=d+1;
sw:=prim(d);
end;

IF a mod d=0 then
begin
a:=a div d;
nr:=nr+1;
end;
d:=d+1;
end;
factori:=nr;
end;

begin
assign(f,'pairs.in');reset(f);
assign(g,'pairs.out');rewrite(g);
readln(f,n);
max:=0;

for i:=1 to n do
begin
readln(f,m[i]); x[m[i]]:=1;
if max<m[i] then max:=m[i];
end;

{for i:=1 to max do
for k:=1 to n do if m[k] mod i=0 then x[i]:=x[i]+1;}

{for i:=2 to max do
if prim(i) then x[i]:=1;

for i:=2 to max do
if x[i]=1 then
for k:=2 to max div i do
if k mod i<>0 then x[i*k]:=0;}


{for i:=2 to max div 2 do
if x[i]=-1 and prim(i) then
begin
x[i]:=max div i;
for k:=1 to max div(I*i) do
begin
x[i]:=x[i]-1;
x[k*i*i]:=1;
end;
end;}

{for i:=2 to max do
for k:=1 to n do
if m[k] mod i=0 then
begin
x[i]:=x[i]+1;
if m[k] mod (i*i)=0 then x[m[k]]:=0;
end;}

for i:=2 to max do
for k:=2 to max div i do
if x[i*k]<>0 then x[i]:=x[i]+1;

for i:=2 to max do
if not(prim(i)) then for k:=1 to max div i do x[i]:=0;


res:=0;

for p:=2 to max do
if x[p]>0 then
begin
fp:=factori(p);
if fp mod 2<>0 then res:=res+(x[p]*(x[p]-1)) div 2
else res:=res-(x[p]*(x[p]-1)) div 2;
end;

write(g,(n*(n-1) div 2)-res);
close(g);
end.