Страница 1 из 1

Разбивка текста на предложения

СообщениеДобавлено: 13.06.2008 (Пт) 14:26
ndemidov
Здесь представлена моя попытка написать алгоритм разбивки текста на предложения. Будет интересно его улучшить.

Ф-я для считывания предложения.
Код: Выделить всё
Public Function ReadSentence(ByRef RefStr As String) As String
        ' Ф-я возвращает предложение считанное из переданной строки RefStr
        ' и укорачивает RefStr на одно предложение.

        Dim str As String = LTrim(RefStr)
        Dim sSentence, sLeft, L3 As String
        Dim cOpenBrackets As Int32 = 0

        Do Until (str = "")
            sLeft = Left(str, 1)
            L3 = Right(Left(str, 3), 1)

            ' Проверка на открывающие скобки.
            If (sLeft = "(" Or sLeft = "[" Or sLeft = "{") Then
                ' Сщитать символ.
                sSentence &= sLeft
                str = Right(str, Len(str) - 1)
                ' увеличить счётчик скобок.
                cOpenBrackets += 1


                ' Проверка на закрывающие скобки.
            ElseIf (sLeft = ")" Or sLeft = "]" Or sLeft = "}") Then
                ' Сщитать символ.
                sSentence &= sLeft
                str = Right(str, Len(str) - 1)
                ' уменьшить счётчик скобок
                If (cOpenBrackets > 0) Then cOpenBrackets -= 1


                ' Проверка на сокращение. (работает только если 3-й символ - строчная буква)
            ElseIf Left(str, 2) = ". " And Len(str) >= 3 _
            And L3 = LCase(L3) And Not (L3 = UCase(L3)) Then
                ' Сщитать символ.
                sSentence &= sLeft
                str = Right(str, Len(str) - 1)



                ' Конец предложения?
                ' (Если открыты скобки, то игнорируем другие знаки,
                '  если после знака ничего нет, то это последнее предложение,
                '  если после знака НЕТ пробела (там любой другой символ), то это не конец
                '  предложения (предложения разделяются между собой пробелами).)
            ElseIf (cOpenBrackets = 0) _
            And (Len(str) > 3 And (Left(str, 4) = "... ") _
              Or Len(str) = 3 And (Left(str, 3) = "...") _
              Or Len(str) > 1 And (Left(str, 2) = ". " Or Left(str, 2) = "! " Or Left(str, 2) = "? ") _
              Or Len(str) = 1 And (sLeft = "." Or sLeft = "!" Or sLeft = "?")) Then

                ' Сщитать символ.
                If Left(str, 3) = "..." Then
                    ' Сщитать 3 символа.
                    sSentence &= Left(str, 3)
                    str = Right(str, Len(str) - 3)
                Else
                    ' Сщитать 1 символ.
                    sSentence &= sLeft
                    str = Right(str, Len(str) - 1)
                End If
                Exit Do


                ' Обычный символ.
            Else
                sSentence &= sLeft
                str = Right(str, Len(str) - 1)
            End If
        Loop


        ' Check brackets
        If Not (cOpenBrackets = 0) Then
            MsgBox("Warning in ReadSentense." & vbCrLf & "Количество незакрытых открывающих скобок: " & cOpenBrackets, MsgBoxStyle.Exclamation)
        End If

        ' Return rezult.
        RefStr = str
        Return sSentence
    End Function


До первого вызова ф-и считываем текст в перем. s, затем [syntax="vb"]s = Replace(s, vbCrLf, " ")[/syntax].
Затем прогоном по циклу считываем предложения в масиив
Код: Выделить всё
Do Until (s = "")
            CurSentenses += 1
            Sentenses(CurSentenses) = ReadSentence(s)
        Loop

СообщениеДобавлено: 16.06.2008 (Пн) 9:47
ndemidov
А вот универсальная ф-я, определяющая является ли символ буквой.
Код: Выделить всё
Public Function IsLetter(ByVal str As String) As Boolean
        ' Ф-я возвращает TRUE, если все символы в RefString - буквы.
        Dim i As Int32, l As String
        str = LCase(str)

        For i = 1 To Len(str)
            l = Right(Left(str, i), 1)
            If (l = UCase(l)) Then
                Return False
            End If
        Next

        If (str = "") Then Return False
        Return True
    End Function

Re: Разбивка текста на предложения

СообщениеДобавлено: 06.12.2009 (Вс) 14:17
Antonariy
Сщитать, опупеть не надо. После того, как я несколько раз наткнулся на это слово, появилось настойчивое желание вступить в карательный корпус grammar nazi.

Посмотрим, как работает это алго, учитывая грамотность автора.

Re: Разбивка текста на предложения

СообщениеДобавлено: 06.12.2009 (Вс) 14:23
Хакер
Автор, парсер, основанный на Mid$, Left$, InStr и им подобных --- это заведомо плохой парсер.

Re: Разбивка текста на предложения

СообщениеДобавлено: 06.12.2009 (Вс) 14:36
MIT
ndemidov писал(а):Sentences VB.NET.rar
Написан на VB.NET.
Не думаю, что на .NET`е можно писать вот так. Автору на заметку: есть Char.IsLetter и замечательные классы String и StringBuilder.

2Хакер: там нет ни Mid$, ни Left$, там есть Right(Left(str, i), 1) :roll:

Re: Разбивка текста на предложения

СообщениеДобавлено: 06.12.2009 (Вс) 16:07
iGrok
Вступлю в сообщество некрофилов четвёртым.

З.Ы. Думаю, автор очень обрадуется, когда поймёт что через полтора года на его тему обратило внимание столько народу... )))

Re: Разбивка текста на предложения

СообщениеДобавлено: 06.12.2009 (Вс) 20:28
ndemidov
iGrok писал(а):Вступлю в сообщество некрофилов четвёртым.

З.Ы. Думаю, автор очень обрадуется, когда поймёт что через полтора года на его тему обратило внимание столько народу... )))


:lol: