Нечітке порівняння рядків, MS Office, Програмні керівництва, статті

Аргументи: lngMaxLen – Максимальна довжина порівнюваних підрядків (читайте опис алгоритму порівняння рядків), strStringMatching– Перший рядок, strStringStandart – Другий рядок, lngCase – Тип порівняння (з урахуванням регістру або без обліку)
Призначення: Нечітке порівняння двох рядків
Повертає: Повертає коефіцієнт збігу рядків від 0 до 100 (0 – рядки не збігаються, 100 – повний збіг).

Public Type RetCount
lngSubRows As Long
lngCountLike As Long
End Type

Public Function IndistinctMatching(lngMaxLen As Long, strStringMatching As String, strStringStandart As String, lngCase As Long) As Long
Dim gret As RetCount
Dim tret As RetCount
Dim lngCurLen As Long 

If lngMaxLen = 0 Or Len(strStringMatching) = 0 Or Len(strStringStandart) = 0 Then
    IndistinctMatching = 0
    Exit Function
End If
gret.lngCountLike = 0
gret.lngSubRows = 0
For lngCurLen = 1 To lngMaxLen
    tret = MatchingStrings(strStringMatching, strStringStandart, lngCurLen, lngCase)
    gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
    gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
    tret = MatchingStrings(strStringStandart, strStringMatching, lngCurLen, lngCase)
    gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
    gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
Next lngCurLen
If gret.lngSubRows = 0 Then
    IndistinctMatching = 0
    Exit Function
End If
IndistinctMatching = (gret.lngCountLike / gret.lngSubRows) * 100
End Function

Public Function MatchingStrings(strA As String, strB As String, lngLen As Long, lngCase As Long) As RetCount
Dim tret As RetCount
Dim y As Long, z As Long
Dim strta As String
Dim strtb As String

For z = 1 To Len(strA) – lngLen + 1
    strta = Mid(strA, z, lngLen)
    y = 1
    For y = 1 To Len(strB) – lngLen + 1
        strtb = Mid(strB, y, lngLen)
        If StrComp(strta, strtb, lngCase) = 0 Then
            tret.lngCountLike = tret.lngCountLike + 1
            Exit For
        End If
    Next y
    tret.lngSubRows = tret.lngSubRows + 1
Next z
MatchingStrings.lngCountLike = tret.lngCountLike
MatchingStrings.lngSubRows = tret.lngSubRows
End Function

Алгоритм порівняння рядків
Функція нечіткого порівняння використовує в якості аргументів два рядки і параметр порівняння – максимальну довжину порівнюваних підрядків. Результатом роботи функції є число, що лежить в межах від 0 до 1. 0 відповідає повному розбіжності двох рядків, а 1 – повною (в певному нижче сенсі) їх ідентичності.
Порівняння рядків відбувається за такою схемою. Нехай, наприклад, в якості аргументів задані два рядки “test” і “text” і деяка максимальна довжина підрядків, скажімо, 4. Функція порівняння становить все можливі комбінації підрядків з довгою аж до зазначеної та підраховує їх збігу у двох порівнюваних рядках. Кількість збігів, розділене на число варіантів, оголошується коефіцієнтом схожості рядків і видається як результат роботи функції.

Продовжимо приклад.





























































































































Порівнювана підрядок

Підрядка другого рядка

Є збіг?

Кількість збігів

Кількість варіантів


Порівнюємо рядок test з рядком text по підстроками довжини 1.


t


t, e, x, t


да


3


4


e


t, e, x, t


да


s


t, e, x, t


немає


t


t, e, x, t


да


Порівнюємо рядок text з рядком test по підстроками довжини 1.


t


t, e, s, t


да


3


4


e


t, e, s, t


да


x


t, e, s, t


немає


t


t, e, s, t


да


Порівнюємо рядок test з рядком text по підстроками довжини 2.


te


te, ex, xt


да


1


3


es


te, ex, xt


немає


st


te, ex, xt


немає


Порівнюємо рядок text з рядком test по підстроками довжини 2.


te


te, es, st


да


1


3


ex


te, es, st


немає


xt


te, es, st


немає


Порівнюємо рядок test з рядком text по підстроками довжини 3.


tes


tex, ext


немає


0


2


est


tex, ext


немає


Порівнюємо рядок text з рядком test по підстроками довжини 3.


tex


tes, est


немає


0


2


ext


tes, est


немає


Порівнюємо рядок test з рядком text по підстроками довжини 4.


test


text


немає


0


1


Порівнюємо рядок text з рядком test по підстроками довжини 4.


text


test


немає


0


1

Разом


8


20


Наведена таблиця ілюструє алгоритм підрахунку коефіцієнта схожості двох рядків. Для рядків “test” і “text” і довжини максимальної підрядка, що дорівнює 4, ми отримали значення коефіцієнта, рівне 8/20, то є 0,4. Якщо обмежитися підрядками меншої довжини, то ми будемо отримувати інші коефіцієнти: наприклад, для підрядків одиничної довжини результатом буде 6/8 або 0,75. Зауважимо, що якщо як довжини максимальної підрядка задавати значення, великі 4, результат не буде змінюватися: справді, адже у вказаних рядках немає підрядків більшої довжини.
Збільшення довжини максимальної підрядка незначно збільшує час роботи функції (взагалі, слід зауважити, що порівняння виконується досить швидко). З іншого боку, пошук стає більш чітким. Мабуть, оптимального значення довжини максимальної підрядка немає, але я рекомендую ставити його рівним 2-3.

Приклад:

1. Порівняння з урахуванням регістру
If IndistinctMatching(4, “test”, “TEXT”, vbBinaryCompare) > 40 Then …
2. Порівняння без урахування регістру
If IndistinctMatching(4, “test”, “TEXT”, vbTextCompare) > 40 Then …

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*