Определить, на сколько бит различаются два числа

var
n,i,j,q,m,kol,otv,k:longint;
a:array[1..10000]of integer;
begin
readln(n,k);
for i:=1 to n do read(a[i]);
for i:=1 to n-1 do begin
for j:=i+1 to n do begin
    q:=a[i];
    m:=a[j];
    kol:=0;
    while (q>0)or(m>0) do begin
        if (q mod 2)<>(m mod 2) then inc(kol);
        q:=q div 2;
        m:=m div 2;
    end;
    if kol=k then inc(otv);
end;
end;
writeln(otv);
end.

c:=a[i] xor a[b] ;
while c>0 do begin
if c mod 2 = 1 then inc(kol);
c:=c div 2;
end;

program BitsCount;
 
var
  Bits08: array [0..255] of integer;
  Bits20: array [0..(1 shl 20) - 1] of integer;
  n, k: longint;
  a: array [0..10000] of longint;
  i, j: longint;
  Amount: longint;
  x: longint;
begin
  randomize;
  {ввод исходных данных}
  readln(n, k);
  for i := 0 to n - 1 do
    //Read(a[i]);
    a[i] := random(10000);
  {предвычисление таблицы}
  for i := 0 to 255 do
  begin
    x := ((i shr 1) and $55) + (i and $55);
    x := ((x shr 2) and $33) + (x and $33);
    x := ((x shr 4) and $0F) + (x and $0F);
    Bits08[i] := x;
  end;
  for i := 0 to high(Bits20) do
    Bits20[i] := Bits08[i and $FF] + Bits08[(i shr 8) and $FF] +
      Bits08[(i shr 16) and $FF];
  {вычисление результата}
  Amount := 0;
  for i := 0 to n - 2 do
    for j := i + 1 to n - 1 do
    begin
      x := a[i] xor a[j];
      if k = Bits20[x] then
        Inc(Amount);
    end;
  writeln(Amount);
end.

var
  Bits08: array [0..255] of Integer;
  n, k: longint;
  a: array [0..10000] of Longint;
  i, j: Integer;
  Amount, x: Longint;
begin
  Randomize;
  {ввод исходных данных}
  ReadLn(n, k);
  for i := 0 to n - 1 do
    {Read(a[i]);}
    a[i] := Random(10000);
  {предвычисление таблицы}
  for i := 0 to 255 do
  begin
    x := ((i shr 1) and $55) + (i and $55);
    x := ((x shr 2) and $33) + (x and $33);
    x := ((x shr 4) and $0F) + (x and $0F);
    Bits08[i] := x;
  end;
  {вычисление результата}
  Amount := 0;
  for i := 0 to n - 2 do
    for j := i + 1 to n - 1 do
    begin
      x := a[i] xor a[j];
      if k = Bits08[x and $FF] + Bits08[(x shr 8) and $FF] +
        Bits08[(x shr 16) and $FF]
      then Inc(Amount);
    end;
  WriteLn(Amount);
end.

const MaxBit=16;
var
  a: array [0..MaxBit] of Longint;
  b: array [0..255] of Integer;
  n, i, t: Longint;
  k, j: Integer;
  r: Int64;
begin
  Randomize;
  {предвычисление таблицы}
  for j:=0 to 255 do begin
    k:=((j shr 1) and $55)+(j and $55);
    k:=((k shr 2) and $33)+(k and $33);
    k:=((k shr 4) and $0F)+(k and $0F);
    b[j]:=k;
  end;
  ReadLn(n,k);
  for n:=1 to n do begin
    t:=(Longint(Random(65535))+Random(65535)) mod 100001;
    Inc(a[b[ t         and $FF]+
          b[(t shr 8)  and $FF]+
          b[(t shr 16) and $FF]]);
  end;
  for j:=k to MaxBit do  Inc(r,a[j-k]*a[j]);
  WriteLn(r);
end.