(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

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

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

Ссылки по теме


 Распечатать »
 Правила публикации »
  Обсудить материал в конференции Microsoft »
Обсудить материал в конференции Дизайн, графика, обработка изображений »
Написать редактору 
 Рекомендовать » Дата публикации: 23.01.2008 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Microsoft Office 365 Бизнес. Подписка на 1 рабочее место на 1 год
Microsoft System Center Standard Core Sngl License/Software Assurance Pack OLP 2Licenses NoLevel CoreLic Qualified
Microsoft Office 365 для Дома 32-bit/x64. 5 ПК/Mac + 5 Планшетов + 5 Телефонов. Подписка на 1 год.
Microsoft Windows Professional 10, Электронный ключ
Microsoft Office 365 Профессиональный Плюс. Подписка на 1 рабочее место на 1 год
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Безопасность компьютерных сетей и защита информации
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
Программирование на Visual С++
Новости мира 3D-ускорителей
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
Обсуждения в форумах
Как изменить шрифт Wordpad? (3)
Как изменить шрифт Wordpad по умолчанию? Там Таймс, а мне, допустим, Ариал нужен. Можно ли...
 
Corel. Сохранение файла в старом формате. (25)
у меня есть горящий вопрос по Корелу и никто мне не может дать на него ответ. Я работаю в...
 
Надстройка "Поиск решения" MS Excel (4)
Помогите решить задачу с помощью " поиск решения" мука яйца ...
 
Access, Ключевое поле, Счетчик (9)
Подскажите пожалуйста, как изменить в Access в ключевом поле (счетчик последовательно),...
 
Помощь по MS Access (323)
Доброе время суток. Случайно оказался на этом сайте, искал статьи по OLAP. Вижу, что...
 
 
 



    
rambler's top100 Rambler's Top100