Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   www.boolean.name > Программирование игр для компьютеров > Visual Basic

Ответ
 
Опции темы
Старый 08.09.2013, 20:33   #1
DarkInside
Разработчик
 
Аватар для DarkInside
 
Регистрация: 07.08.2011
Сообщений: 407
Написано 136 полезных сообщений
(для 259 пользователей)
Неточное сравнение текста

Дарова, булка
Пишу скрипт неточного сравнения строк, типа как в поисковиках используется, например, чтобы пользователь вводил в базу "Зеленая петрушка", а скрипт ему: - ты чо, дурак, вот в базе уже есть "Зелень: Петрушка". Чужие алгоритмы не разбирал, ибо больше времени уйдёт, пока разберусь в чужом коде.
Начал думать свой алгоритм...прикинул так: разбивать текст на слова и по 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)
 
Ответить с цитированием
Старый 08.09.2013, 20:53   #2
SBJoker
Злобный Админ
 
Аватар для SBJoker
 
Регистрация: 04.09.2005
Сообщений: 5,901
Написано 3,386 полезных сообщений
(для 9,262 пользователей)
Ответ: Неточное сравнение текста

ИМХО strcmp и прочие производные этой функции сравнения строк, как раз и возвращает число выражающее непохожесть строк.
__________________
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
DarkInside (08.09.2013)
Старый 08.09.2013, 21:06   #3
Phantom
Элита
 
Аватар для Phantom
 
Регистрация: 14.06.2008
Адрес: Украина, Киев
Сообщений: 2,033
Написано 637 полезных сообщений
(для 1,593 пользователей)
Ответ: Неточное сравнение текста

Почитай про Расстояние Левенштейна и почитай смежные темы на хабре.

P.S. Описанный тобой метод - это метод N-грамм. Я использую его на сайте Muza.Name для вычисления схожести текстов местных авторов с текстами известных писателей. Результат можно посмотреть в анкетах пользователей (если там ещё ничего не поломалось при очередном переезде с хостинга на хостинг).
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
DarkInside (08.09.2013)
Старый 08.09.2013, 21:12   #4
DarkInside
Разработчик
 
Аватар для DarkInside
 
Регистрация: 07.08.2011
Сообщений: 407
Написано 136 полезных сообщений
(для 259 пользователей)
Ответ: Неточное сравнение текста

почитал про strcmp - она ведь только в С-подобных языках, а я планирую этот алгоритм в пурике использовать...
глянул хабру, формулы какие-то страшные...но заинтересовало, попробую разобраться, спасибо

А конкретно по моему говнокоду какие предложения есть?

Ого, я еще какой-то метод воспроизвел, не зная о его существовании...ну ничего, я люблю изобретать велосипеды
(Offline)
 
Ответить с цитированием
Старый 10.09.2013, 05:51   #5
pax
Unity/C# кодер
 
Аватар для pax
 
Регистрация: 03.10.2005
Адрес: Россия, Рязань
Сообщений: 7,484
Написано 2,945 полезных сообщений
(для 5,189 пользователей)
Ответ: Неточное сравнение текста

Вот например реализация на php стеммера Портера, Можешь с помощью него преобразовать все слова в базе для создания индекса, а потом по ним искать преобразовывая вводимую в запрос комбинацию таким же образом перед поиском
https://github.com/andyceo/PHP-Porte...m_Ru.class.php
Вот и на яве http://www.algorithmist.ru/2010/12/p...r-russian.html

http://ru.wikipedia.org/wiki/%D0%A1%...B5%D1%80%D0%B0
__________________
Blitz3d to Unity Wiki
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
DarkInside (10.09.2013)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +1, время: 13:40.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com