Рассчитать вес Хэмминга и / или расстояние в VBA Excel

Question

Я пытаюсь сравнить клиентов, два за двумя, чьи качества могут быть определены бинарным выбором (например, клиент использует продукт или нет).
После долгих поисков в Интернете мне кажется, что для этого мне нужно использовать расстояние Хэмминга или его эквивалент: найти вес Хэмминга для результата операции XOR между двумя словами.

Для конкретного примера, расстояние Хэмминга между 1001 и 1011:

Рассчитать число 1001 XOR 1011= 0010
Вес Хэмминга, равный 0010 = 1 (число битов установлено в 1 в 0010)

Мне нужно сделать это для слов до 96 бит.

Я нашел некоторую информацию о

http://people.revoledu.com/kardi/tutorial/Similarity/HammingDistance.html

http://trustedsignal.blogspot.ca/2015/06/xord-play-normalized-hamming-distance.html

и много кусков кода, например

Вес Хэмминга записан только в бинарных операциях?

но только в C, Java, Perl, O, opencl... все, кроме Excel VBA.

Пока что вот что мне удалось собрать.

Это работает, но, к сожалению, только для слов длиной 30 бит или меньше, и использует несколько грубый метод: XOR для двух чисел X и Y, а затем преобразовать в строку, представляющую двоичное число. Затем посчитайте длину строки, как только 1 будут удалены. Я думаю, что есть более элегантный и эффективный способ.

Public Function HamDist(x As Long, y As Long, NbBit As Integer)

Dim i As Long, BinStrg As String, bxor As Long 

bxor = x Xor y 

BinStrg = "" 

For i = NbBit To 0 Step -1 ‘going from left to right 
         If bxor And (2 ^ i) Then
            BinStrg = BinStrg + "1" ‘add a 1 to the string 
         Else
            BinStrg = BinStrg + "0"
         End If
      Next

 HamDist = Len(BinStrg) - Len(Replace(BinStrg, "1", "")) ' replace the 1 by nothing and count  the length of the resulting string 
End Function

Можете ли вы помочь заставить его работать для 96-битных слов в VBA для Excel 2010 и ниже (udf или sub), вычисляя вес Хемминга или расстояние?

Answer 1

Если вы храните цепочку качеств в форме String (например, String, состоящую только из букв "T" и "F"), это можно легко сделать с помощью цикла.

Function hammingDistance(qualities1 As String, qualities2 As String) As Integer

    If Len(qualities1) <> Len(qualities2) Then
        hammingDistance = -1
        Exit Function
    End If

    Dim i, result As Integer
    result = 0

    For i = 1 To Len(qualities1)
        If Mid(qualities1, i, 1) <> Mid(qualities2, i, 1) Then result = result + 1
    Next

    hammingDistance = result

End Function