Twtrize — сократитель речи

Как известно, письменность избыточна: мы можем угадывать написанные слова, даже если некоторые буквы неразборчивы, перепутаны местами или вообще отсутствуют. К счастью, в компьютерной письменности все буквы разборчивы, почерк у всех одинаково хорош. Именно поэтому появилась возможность очень сильно сокращать слова, убирая из них «лишние» буквы.

Люди иногда сознательно сокращают слова, набирая SMS или твиты — чтобы потратить меньше денег или укоротить сообщение.

Идея возникла, когда на одном из многочисленных «сократителей URL» я увидел надпись «Shrink text». И мне пришло в голову, что вот он возьмёт, и сократит сам текст: выдаст что-нибудь вроде «shrnk txt». Конечно, сервис всего лишь заменял в тексте URL, но я подумал, что можно было бы сокращать и сам текст.

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

Программа преобразует текст на русском языке, выкидывая из него некоторые буквы и символы. Прошу рассматривать это как забавную игрушку и программой не злоупотреблять.

Зависимости

Программа написана на Literate Haskell (это значит, что то, что, вы сейчас читаете, и есть программа!). Используются следующие модули:

> import System.IO.UTF8 as U
> import Data.Char (toLower)
> import Text.Regex.Posix ((=~))
> import Data.Char (isPunctuation)

TODO: Я использую старый способ работать с UTF-8 (utf8-string), надо переделать под новую библиотеку text.

Алгоритм

Данная программа «сжимает» русский текст так:
I. Из слов убираются (почти) все гласные и мягкие знаки,

> filterVowels = filter (`notElem` (aVowels ++ jVowels))

Неприкосновенны гласные, которые:
I.a. являютя частью приставки «не-»

> rmVowels = map wordFilter
>   where
>    wordFilter ('н':'е':cs) = "не" ++ wordFilter cs

I.b. стоят в трёх- и менее -буквенных словах

>    wordFilter w = if length w <= 3
>                    then w

I.c. стоят в начале или конце слова

>                    else
>                      let (prefix,inner,ending) = splitWord w
>                      in prefix ++ (ajaFilter inner) ++ ending

>    splitWord s  = let p = takeWhile dontRemove s
>                       r = drop (length p) s
>                       e = reverse $ takeWhile dontRemove $ reverse r
>                       m = take ((length r) - (length e)) r
>                       dontRemove c = c `elem` vowels || isPunctuation c
>                    in (p,m,e)

I.d. являются комбинациями со звуком «й»: «-ою-», «-ая—» и проч.

>    ajaFilter [] = []
>    ajaFilter s  = let (b,m,a) = s =~ diftPat :: (String,String,String)
>                       diftPat = "[" ++ vowels ++ "][" ++ jVowels ++ "]"
>                    in (sameConsFilter b) ++ m ++ (ajaFilter a)

I.e. стоят меж двух одинаковых согласных

>    sameConsFilter [] = []
>    sameConsFilter s  =
>      let (b,m,a) = s =~ sameConsPat :: (String,String,String)
>          sameConsPat = "(["++consonants++"])[" ++ vowels ++ "]\\1"
>       in (filterVowels b) ++ m ++ (sameConsFilter a)

Программа использует такой список гласных:

> vowels = aVowels ++ jVowels

где есть и простые гласные (к ним же причислен и мягкий знак)

> aVowels = "аиоуыэь"

и дифтонгообразующие (не знаю правильного термина — в общем, дающие звук «й»),
к ним же причислена и буква «й»:

> jVowels = "яйёюе"

Для некоторых правил требуется также список русских согласных:

> consonants = "бвгджзклмнпрстфхцчшщ"

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

> rmSomePunctuation = filter (not . null) . map rmTrailing
>   where rmTrailing      = reverse . rmHead . reverse
>         rmHead []       = []
>         rmHead s@(c:cs) = case c `elem` rmlist of
>             True -> rmHead cs
>             False -> s

Список подлежащих удалению знаков препинания:

>         rmlist = ",;-—:–"

III. из текста удаляются некоторые предлоги (в телеграфном стиле)

> rmPrepositions = filter (`notElem` preps) . words
>   where preps = [ "в", "во", "на", "над", "к", "от", "из"
>                 , "по", "под", "через" ]

IV. для пущей стилизации текст пишется в нижнем регистре

> tolower = map toLower

Использование программы

Программу можно использовать как простой unix-фильтр: он читает текст из потока stdin и печает «сжатый» текст в стандартный вывод (stdout).

> main = U.interact $ (++ "\n") . twtrize

> twtrize = unwords . filter ( not . null ) .
>           rmVowels . rmSomePunctuation . rmPrepositions . tolower

Пример:

    $ printf "Гласные, а также некоторые предлоги — как, например, «на», — из \
    текста удаляются, но какие-то остаются.\n" | runhaskell twtrize.lhs
    глсные а ткже нектрые прдлги как нпрмр «на» ткста удляются но какие-то
    остаются.

Последняя версия: исходник здесь. Лицензия: BSD-3.