|
09.09.2013, 00:33
|
#1
|
Разработчик
Регистрация: 08.08.2011
Сообщений: 505
Написано 191 полезных сообщений (для 369 пользователей)
|
Неточное сравнение текста
Дарова, булка
Пишу скрипт неточного сравнения строк, типа как в поисковиках используется, например, чтобы пользователь вводил в базу "Зеленая петрушка", а скрипт ему: - ты чо, дурак, вот в базе уже есть "Зелень: Петрушка". Чужие алгоритмы не разбирал, ибо больше времени уйдёт, пока разберусь в чужом коде.
Начал думать свой алгоритм...прикинул так: разбивать текст на слова и по 2 символа сравнивать, например, "зе-ле-на-я" + "пе-тр-уш-ка" AND "зе-ле-нь" + "пе-тр-уш-ка" ...и второй проход со смещением на 1 символ: "ел-ен-ая" + "ет-ру-шк-а" AND "ел-ен-ь" + "ет-ру-шк-а" а потом подсчитывать процент совпадения.
В общем вроде работает, но большой процент ошибок...посоветуйте на пальцах как доработать код, может добавить проверку по 3 символа, чтобы точнее работало? тока не надо чужой код, лучше посоветуйте на словах
Вот сам код, пишу пока на vba, т.к. база продуктов в экселе:
Public scan1, scan2, x
Public Const di11 = 3, di12 = 87, di21 = 96, di22 = 199 ' диапазон для сравнения
Public search(di11 To di12, di21 To di22) As Integer
Sub win(): Erase search()
For x = di11 To di12
a = LCase(Cells(x, 1))
' если в первой строке 2 слова, то разделяем их на a1 и a2:
If InStr(a, " ") <> 0 Then
a1 = Left(a, InStr(a, " ") - 1)
a2 = Right(a, Len(a) - InStr(a, " "))
Else: a1 = a: a2 = ""
End If
' первый проход для a1
While Not exit_ = 1
scan1 = Left(a1, 2)
sli = b_search()
If Len(a1) > 2 Then a1 = Right(a1, Len(a1) - 2) Else exit_ = 1
Wend: exit_ = 0
If a2 <> "" Then
a1 = Left(a, InStr(a, " ") - 1)
Else: a1 = a
End If
' второй проход со смещением -1 для a1
a1 = Right(a1, Len(a1) - 1)
While Not exit_ = 1
scan1 = Left(a1, 2)
sli = b_search()
If Len(a1) > 2 Then a1 = Right(a1, Len(a1) - 2) Else exit_ = 1
Wend: exit_ = 0
If a2 <> "" Then
a1 = Left(a, InStr(a, " ") - 1)
Else: a1 = a
End If
If a2 <> "" Then
' первый проход для a2
While Not exit_ = 1
scan1 = Left(a2, 2)
sli = b_search()
If Len(a2) > 2 Then a2 = Right(a2, Len(a2) - 2) Else exit_ = 1
Wend: exit_ = 0: a2 = Right(a, Len(a) - InStr(a, " "))
' второй проход со смещением -1 для a2
a2 = Right(a2, Len(a2) - 1)
While Not exit_ = 1
scan1 = Left(a2, 2)
sli = b_search()
If Len(a2) > 2 Then a2 = Right(a2, Len(a2) - 2) Else exit_ = 1
Wend: exit_ = 0: a2 = Right(a, Len(a) - InStr(a, " "))
End If
Next
For x = di11 To di12
For y = di21 To di22
If search(x, y) >= 2 Then
a = Cells(x, 1): b = Cells(y, 1)
If Len(a) >= Len(b) Then ' находим самую короткую из 2х сравниваемых строк
mini = Len(b)
Else: mini = Len(a)
End If
If search(x, y) > mini Then search(x, y) = mini ' совпадений не может быть больше, чем символов
proc = (100 / mini) * search(x, y) ' считаем процент совпадений
If a = b Then
proc = 100
ElseIf proc > 95 Then proc = 95 ' всегда есть шанс на ошибку (:
End If
If proc > 70 Then MsgBox Cells(x, 1) + " = " + Cells(y, 1) & vbNewLine & "Вероятность = " + Str(proc) + "%"
End If
Next
Next
End Sub
Function b_search()
For y = di21 To di22
b = LCase(Cells(y, 1))
' если в первой строке 2 слова, то разделяем их на b1 и b2:
If InStr(b, " ") <> 0 Then
b1 = Left(b, InStr(b, " ") - 1)
b2 = Right(b, Len(b) - InStr(b, " "))
Else: b1 = b: b2 = ""
End If
'первый проход для b1
While Not exit_ = 1
scan2 = Left(b1, 2)
If scan1 = scan2 Then search(x, y) = search(x, y) + 1
If Len(b1) > 2 Then b1 = Right(b1, Len(b1) - 2) Else exit_ = 1
Wend: exit_ = 0
If b2 <> "" Then
b1 = Left(b, InStr(b, " ") - 1)
Else: b1 = b
End If
' второй проход со смещением -1 для b1
b1 = Right(b1, Len(b1) - 1)
While Not exit_ = 1
scan2 = Left(b1, 2)
If scan1 = scan2 Then search(x, y) = search(x, y) + 1
If Len(b1) > 2 Then b1 = Right(b1, Len(b1) - 2) Else exit_ = 1
Wend: exit_ = 0
If b2 <> "" Then
b1 = Left(b, InStr(b, " ") - 1)
Else: b1 = b
End If
If b2 <> "" Then
' первый проход для b2
While Not exit_ = 1
scan2 = Left(b2, 2)
If scan1 = scan2 Then search(x, y) = search(x, y) + 1
If Len(b2) > 2 Then b2 = Right(b2, Len(b2) - 2) Else exit_ = 1
Wend: exit_ = 0: b2 = Right(b, Len(b) - InStr(b, " "))
' второй проход со смещением -1 для b2
b2 = Right(b2, Len(b2) - 1)
While Not exit_ = 1
scan2 = Left(b2, 2)
If scan1 = scan2 Then search(x, y) = search(x, y) + 1
If Len(b2) > 2 Then b2 = Right(b2, Len(b2) - 2) Else exit_ = 1
Wend: exit_ = 0: b2 = Right(b, Len(b) - InStr(b, " "))
End If
Next
End Function
А вот результат удачной работы, но ошибается пока очень часто
|
(Offline)
|
|
09.09.2013, 00:53
|
#2
|
Злобный Админ
Регистрация: 04.09.2005
Сообщений: 5,926
Написано 3,415 полезных сообщений (для 9,330 пользователей)
|
Ответ: Неточное сравнение текста
ИМХО strcmp и прочие производные этой функции сравнения строк, как раз и возвращает число выражающее непохожесть строк.
__________________
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
09.09.2013, 01:06
|
#3
|
Элита
Регистрация: 14.06.2008
Адрес: Украина, Киев
Сообщений: 2,273
Написано 754 полезных сообщений (для 1,833 пользователей)
|
Ответ: Неточное сравнение текста
Почитай про Расстояние Левенштейна и почитай смежные темы на хабре.
P.S. Описанный тобой метод - это метод N-грамм. Я использую его на сайте Muza.Name для вычисления схожести текстов местных авторов с текстами известных писателей. Результат можно посмотреть в анкетах пользователей (если там ещё ничего не поломалось при очередном переезде с хостинга на хостинг).
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
09.09.2013, 01:12
|
#4
|
Разработчик
Регистрация: 08.08.2011
Сообщений: 505
Написано 191 полезных сообщений (для 369 пользователей)
|
Ответ: Неточное сравнение текста
почитал про strcmp - она ведь только в С-подобных языках, а я планирую этот алгоритм в пурике использовать...
глянул хабру, формулы какие-то страшные...но заинтересовало, попробую разобраться, спасибо
А конкретно по моему говнокоду какие предложения есть?
Ого, я еще какой-то метод воспроизвел, не зная о его существовании...ну ничего, я люблю изобретать велосипеды
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 07:09.
|