又抢先我一步,真坑爹
var
i,j,n,nb:integer;
a:array [1..100] of integer;
begin
while true do
begin
fillchar(a,sizeof(a),0);
read(a[1]);
if a[1]=-1 then exit;
i:=1;
while a[i]<>0 do
begin
inc(i);
read(a[i]);
end;
n:=i-1;
j:=0;
nb:=0;
for i:=1 to n-1 do
for j:=i+1 to n do
if (a[i]=a[j]*2) or (a[j]=a[i]*2) then inc(nb);
writeln(nb);
end;
end.