MyTetra Share
Делитесь знаниями!
Нечеткое сравнение строк
16.03.2019
23:43
Текстовые метки: сравнение строк
Раздел: !Закладки - VBA - Операции с датами-временем

Нечеткое сравнение строк


Аргументы: 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

 
MyTetra Share v.0.52
Яндекс индекс цитирования