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

Алгоритмы, использующиеся при работе с естественными языками.
ndemidov
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 285
Зарегистрирован: 14.11.2007 (Ср) 16:23
Откуда: Earth planet

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

Сообщение ndemidov » 13.06.2008 (Пт) 14:26

Здесь представлена моя попытка написать алгоритм разбивки текста на предложения. Будет интересно его улучшить.

Ф-я для считывания предложения.
Код: Выделить всё
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
Вложения
Sentences VB.NET.rar
Написан на VB.NET.
(62.59 Кб) Скачиваний: 207
Последний раз редактировалось ndemidov 21.01.2009 (Ср) 16:05, всего редактировалось 1 раз.

ndemidov
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 285
Зарегистрирован: 14.11.2007 (Ср) 16:23
Откуда: Earth planet

Сообщение ndemidov » 16.06.2008 (Пн) 9:47

А вот универсальная ф-я, определяющая является ли символ буквой.
Код: Выделить всё
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

Antonariy
Повелитель Internet Explorer
Повелитель Internet Explorer
Аватара пользователя
 
Сообщения: 4824
Зарегистрирован: 28.04.2005 (Чт) 14:33
Откуда: Мимо проходил

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

Сообщение Antonariy » 06.12.2009 (Вс) 14:17

Сщитать, опупеть не надо. После того, как я несколько раз наткнулся на это слово, появилось настойчивое желание вступить в карательный корпус grammar nazi.

Посмотрим, как работает это алго, учитывая грамотность автора.
Лучший способ понять что-то самому — объяснить это другому.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16278
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

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

Сообщение Хакер » 06.12.2009 (Вс) 14:23

Автор, парсер, основанный на Mid$, Left$, InStr и им подобных --- это заведомо плохой парсер.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

MIT
Мега гуру
Мега гуру
Аватара пользователя
 
Сообщения: 2211
Зарегистрирован: 17.09.2006 (Вс) 22:46

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

Сообщение MIT » 06.12.2009 (Вс) 14:36

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

2Хакер: там нет ни Mid$, ни Left$, там есть Right(Left(str, i), 1) :roll:
Изображение
You can change your face, but can`t change your mind. No matter what you do.
Создайте еще более понятный интерфейс и мир создаст еще более тупого юзера. (с) Баш

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4267
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

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

Сообщение iGrok » 06.12.2009 (Вс) 16:07

Вступлю в сообщество некрофилов четвёртым.

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

ndemidov
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 285
Зарегистрирован: 14.11.2007 (Ср) 16:23
Откуда: Earth planet

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

Сообщение ndemidov » 06.12.2009 (Вс) 20:28

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

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


:lol:
Большинство людей не понимает, что великое многообразие и красочность мира будут служить им крепчайшей душевной поддержкой на протяжении всей жизни. Иван Ефремов


Вернуться в Лингвистика

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

    TopList