Различие текста

[Demonx]

Есть два почти одинаковых текста в двух переменных, в одном из которых есть некоторое отличние (т.е пару там слов не таких). Как узнать различие в процентах между этими двумя текстами (т.е. много или мало поменялось, в процентах)?

[Konst_One]

тут тебе поможет высшая математика, раздел статистики и вероятности. поищи алгоритмы похожести

[Demonx]

а готового кода нигде не встречал?

[Antonariy]

Я где-то находил такую функцию на vb...

[gjghjc]

Найдешь, скинь ссылку, мне чувствую в ближайшее время понадобится проверять текст на совпадение, но не жесткое а так.. плюс мину пара символов.

[Lumen]

А строки большие? Как насчет тупо сравнить строки посимвольно в цикле, и если символы не совпадают, то инкрементировать счетчик "несовпадений", а затем разделить значение этого счетчика на длину строки и это будет число, на какую часть отличаются строки, которое можно будет потом перевести в проценты и т.д.

[Konst_One]

если бы было так просто

[Twister]

Первая ссылка в гугл по запросу "Неточное сравнение строк"

Которую надо было вставить правильно, чтобы топик не разъезжался. --GSerg

[Antonariy]

Еще это.

gjghjc
Эту функцию я скопировал в текстовый файл, который теперь не могу найти.

[Хакер]

Lumen
что насчёт сравнения твоим способом сток "фууубар!" и "фуубар!" ?

[gjghjc]

Antonariy
Если не трудно, поищи, пожалуйста.
А то что выложено по ссылке вроде походе на то что нужно.

[Antonariy]

Нашел таки. В файле с юмором.
Умножь возвращаемое значение на 100 и получишь проценты.

Код: Выделить всё

Private b1() As Byte
Private b2() As Byte

Public Function Simil(String1 As String, String2 As String) As Double
Dim l1 As Long
Dim l2 As Long
    If UCase(String1) = UCase(String2) Then
        Simil = 1
    Else
        l1 = Len(String1)
        l2 = Len(String2)
        If l1 <> 0 And l2 <> 0 Then
            b1 = StrConv(UCase$(String1), vbFromUnicode)
            b2 = StrConv(UCase$(String2), vbFromUnicode)
            Simil = SubSim(1, l1, 1, l2) / (l1 + l2) * 2
        End If
    End If
    Erase b1
    Erase b2
End Function

Private Function SubSim(st1 As Long, end1 As Long, st2 As Long, end2 As Long) As Long
Dim c1 As Long
Dim c2 As Long
Dim ns1 As Long
Dim ns2 As Long
Dim i As Long
Dim max As Long
    If st1 > end1 Or st2 > end2 Or st1 <= 0 Or st2 <= 0 Then Exit Function
    For c1 = st1 To end1
        For c2 = st2 To end2
            i = 0
            Do Until b1(c1 + i - 1) <> b2(c2 + i - 1)
                i = i + 1
                If i > max Then
                    ns1 = c1
                    ns2 = c2
                    max = i
                End If
                If c1 + i > end1 Or c2 + i > end2 Then Exit Do
            Loop
        Next
    Next
    max = max + SubSim(ns1 + max, end1, ns2 + max, end2)
    max = max + SubSim(st1, ns1 - 1, st2, ns2 - 1)
    SubSim = max
End Function


Исправленному верить

[gjghjc]

Antonariy
Спасибо тебе, добрый человек.
Сейчас сохраню себе и буду разбираться как работает

[alibek]

Antonariy, а я вначале подумал было, что функция будет сравнивать строки с учетом схожести букв

[Antonariy]

alibek
Это ты на SpamCutter намекаешь?

[Demonx]

Antonariy
Вызываю MsgBox Simil("aaabc", "aaaacb") - ошибка Subscript out of range

[iGrok]

Он же написал, что это не его алгоритм, а найденный. Посмотри сам, почему не работает.

[Antonariy]

Прошу прощения, я заменил циклы, в которых строки превращались в массивы на StrConv и не заметил, что нижняя граница массива была 1.
Нужно написать Do Until b1(c1 + i - 1) <> b2(c2 + i - 1)

[Demonx]

Спасибо, работает