Генерация почти осмысленных текстов на Haskell
14 декабря 2011
Недавно в блоге Даркуса была поднята тема генерации уникальных текстов, содержащих в себе некоторый смысл. То есть речь идет о генерации нормальных текстов, вроде того, что вы читаете в данный момент, а не простой мешанины из слов. Тема меня «зацепила» и со второй попытки мне удалось написать довольно неплохой, как мне кажется, генератор. Однако, будучи блогером-графоманом, начну я немного издалека…
Как пытаются делать обычно
Синтез текста является одним из направлений искусственного интеллекта, а значит серьезно задумываться над ним люди стали по крайней мере лет 50 назад. В наше время эта задача особенно сильно волнует умы вебмастеров, по вполне понятным причинам. Тем не менее, среди сайтостроителей широкое распространение получили лишь самые примитивные подходы к генерации текста. Некоторые из них:
- Cинонимизация — это когда в готовом тексте выражения или отдельные слова заменяются на смысловые аналоги. Притом часто синонимизация выполняется вручную или полуавтоматически, хотя намного эффективнее было бы проиндексировать пару миллионов веб-страниц, найти в них несколько тысяч наиболее часто используемых фраз и на их основе вручную составить базу регулярных выражений для выполнения замен в тексте. Такой подход позволил бы автоматически переписывать новости с любого новостного сайта.
- Размножение похоже на синонимизацию, однако включает в себя перестановку фраз, предложений или даже целых абзацев. Размножение текста обычно происходит полуавтоматически. {Сначала | Предварительно} {создается | составляется | заказывается} {шаблон | образец} размножаемого текста, из которого с помощью скрипта создается пара сотен почти уникальных статей. Пример такого скрипта для размножения вы можете найти в 4-м пункте вот этой заметки.
- Цепи Маркова, как выяснилось, тоже давно известны среди сеошников. Генерировать с помощью этого подхода можно как осмысленные тексты, так и мешанину из слов. Однако мешанину поисковые системы распознают, а для генерации осмысленных текстов нужно посидеть и хорошо подумать. Поэтому сеошники больше любят синонимизацию и размножение.
Встречаются и другие подходы. Например, генераторы опечаток или скрытие кусков текста с помощью NoIndex/JavaScript. Описанные приемы хороши тем, что они до неприличия просты и при должном опыте приводят к приемлемому результату. Плохи они тем, что требуют какого-никакого человеческого труда для генераци каждой порции текстов, да и уникальность этих текстов получается, так скажем, не запредельной.
Как обычно не пытаются делать
Честно говоря, сначала я попробовал генерировать мешанину из слов с помощью цепей Маркова. Генерируемый текст при этом выглядел примерно так:
предпочитают именно его следом идут мегафон и билайн зафиксировано не было отмечает газета представитель мвф дэвид хоули отказался сообщить какую либо информацию об электронной переписке пользователей blackberry и иные моменты в новой игре будет ощутимо больше зомби будут гоняться за выжившими
Это не совсем то, что нам хотелось бы получить. Хотя такой текст вполне может служить, скажем, небольшим дополнением к копипасту.
Вторая попытка оказалась более удачной. Суть идеи — есть некоторая модель мира, эдакая сцена, заполненная случайными объектами из некоторой предметной области. Объекты обладают некоторыми свойствами (вес, стоимость, цвет, …) и, скорее всего, как-то друг с другом связаны (программа X установлена на компьютере Y). Кроме того, на сцене происходят некоторые случайные действия, переводящие сцену из одного состояния в другое.
Любой современный язык программирования позволяет без особого труда описать такую сцену и действия на ней. Количество объектов, их свойств и действий на сцене может быть очень велико. Написав программу, способную выдавать текстовое описание сцены, действий на сцене и результат этих действий, мы получим неплохой генератор текстов. У нас на руках уже есть почти все, что нужно. Объектам соответствуют существительные, их свойствам — прилагательные, а действиям над объектами — глаголы. Остается только связать это все в осмысленный текст.
Вообще-то, описанная идея едва ли может претендовать на новизну. Я почти уверен, что люди, работающие в области ИИ, считают программирование таких вещей ерундовой задачей.
Слова дешевы, покажите мне код
В качестве модели мира я выбрал упорядоченное множество трехмерных геометрических фигур различных цветов. Возможных действий над миром три — добавление фигуры, удаление фигуры и перестановка двух фигур местами. Исходники получившегося генератора (всего около 250 непустых строк на Haskell) вы можете скачать здесь.
Описание модели мира вы найдете в файле Model.hs:
module Model where
import System.Random
import Data.List
data Color = Red | Green | Blue | Black | White | Orange | Yellow |
Purple | Brown
deriving (Eq, Enum, Bounded, Show)
data Shape = Cube | Pyramid | Cylinder | Parallelepiped | Sphere
deriving (Eq, Enum, Bounded, Show)
data Object = Object { color :: Color, shape :: Shape }
deriving (Eq, Bounded, Show)
instance Enum Object where
fromEnum t = fromEnum (color t) *
(1 + fromEnum(maxBound :: Shape)) +
fromEnum (shape t)
toEnum n =
Object { color = toEnum cn, shape = toEnum sn }
where
cn = n `div` (1 + fromEnum(maxBound :: Shape))
sn = n `mod` (1 + fromEnum(maxBound :: Shape))
type Scene = [Object]
data Action = Create { pos :: Int, obj :: Object } |
Delete { pos :: Int } |
Move { from :: Int, to :: Int } |
NoAction
deriving (Eq, Show)
-- создаем случайную сцену
initScene :: Int -> IO Scene
initScene n
| n < 1 = initScene 1
| otherwise = initScene' [] n
where
initScene' sc n
| n <= 0 = do return sc
| otherwise = do
action <- generateCreateAction sc
initScene' (evalAction sc action) (n - 1)
-- случайное Create-действие
generateCreateAction :: Scene -> IO Action
generateCreateAction s = do
rpos <- randomRIO (0, length s - 1)
let possibleNewObjects =
[minBound :: Object .. maxBound :: Object] \\ s
ridx <- randomRIO (0, length possibleNewObjects - 1)
return Create { pos = rpos, obj = possibleNewObjects !! ridx }
-- случайные действия и сцена после их выполнения
randomActions :: Scene -> Int -> IO ([Action], Scene)
randomActions sc n =
randomActions' [] sc n
where
randomActions' lst sc n
| n <= 0 = do return (lst, sc)
| otherwise = do
(act, sc') <- randomAction sc
randomActions' (lst ++ [act]) sc' (n - 1)
-- одно случайное действие
randomAction :: Scene -> IO (Action, Scene)
randomAction [] = do return (NoAction, [])
randomAction s = do
r <- randomRIO (0, if length s == 1 then 0 else 2) :: IO Int
rpos <- randomRIO (0, length s - 1)
action <- case r of
0 -> if length s == fromEnum (maxBound :: Object) + 1
then do return Delete { pos = rpos }
else generateCreateAction s
1 -> do
rto <- randomRIO (0, length s - 2)
return Move {
from = rpos,
to = ([0..(length s - 1)] \\ [rpos]) !! rto
}
_ -> do
return Delete { pos = rpos }
return (action, evalAction s action)
-- меняем состояние сцены в соответсивии с действием
evalAction :: Scene -> Action -> Scene
evalAction sc act =
case act of
Create cpos cobj ->
let (l, r) = splitAt cpos sc
in l ++ [cobj] ++ r
Delete dpos -> let (l, r) = splitAt dpos sc in l ++ tail r
Move mfrom mto -> evalMove sc mfrom mto
_ -> sc
where
evalMove sc f t =
map (
\(i,v) ->
if i == f then (sc !! t)
else if i == t then (sc !! f) else v
) $ zip [0..] sc
В модуле Language.Russian.Tiny я собрал функции, которые могут пригодится при написании следующего генератора:
Language.Russian.Tiny v 0.1
(c) Alexandr A Alexeev 2011 | http://eax.me/
-}
module Language.Russian.Tiny where
-- пол (пока хватает двух)
data Gender = Masculine | Feminine
deriving (Eq, Show)
-- падежы
data Case = Nominative | Genitive | Dative | Accusative |
Ablative | Prepositional
deriving (Eq, Enum, Bounded, Show)
-- единственное и множественное число (пока не пригождалось)
-- data Number = Singular | Plural
-- окончания существительных в зависимости от пола и падежа
nounEnd :: Gender -> Case -> String
nounEnd g cs =
endList !! (fromEnum cs)
where
endList
| g == Masculine = ["", "а", "у", "", "ом", "е"]
| otherwise = ["a", "ы", "е", "у", "ой", "е"]
-- окончания прилагательных в зависимости от пола и падежа
defaultAdjectiveEnd :: Gender -> Case -> String
defaultAdjectiveEnd g cs
| cs == Nominative = if g == Masculine then "ый" else "ая"
| cs == Genitive = if g == Masculine then "ого" else "ой"
| cs == Dative = if g == Masculine then "ому" else "ой"
| cs == Accusative = if g == Masculine then "ый" else "ую"
| cs == Ablative = if g == Masculine then "ым" else "ой"
| cs == Prepositional = if g == Masculine then "ом" else "ой"
| otherwise = "(" ++ show cs ++ "," ++ show g ++ ")"
-- окончания прилагательных, исключения:
-- синИЙ/АЯ, синЕГО/ЕЙ, синЕМУ/ЕЙ, синИЙ/ЮЮ, синИМ/ЕЙ, синЕМ/ЕЙ
specialAdjectiveEnd :: Gender -> Case -> String
specialAdjectiveEnd g cs
| cs == Nominative = if g == Masculine then "ий" else "яя"
| cs == Genitive = if g == Masculine then "его" else "ей"
| cs == Dative = if g == Masculine then "eму" else "eй"
-- синИЙ/ЮЮ, но блестящИЙ/УЮ
| cs == Accusative = if g == Masculine then "ий" else "юю"
| cs == Ablative = if g == Masculine then "им" else "ей"
| cs == Prepositional = if g == Masculine then "ем" else "ей"
| otherwise = "(" ++ show cs ++ "," ++ show g ++ ")"
Я вполне мог накосячить с переводом названий падежей на английский язык или еще где-нибудь. Если вы видите ошибку, не стесняйтесь сообщить мне о ней.
Функции, предназначенные непосредственно для генерации текста, собраны в модуле View.Russian. Чтобы понять, о чем там идет речь, достаточно беглого взгляда на следующий кусок кода:
colorToString c g cs
| c == Red = "красн" ++ defaultEnd
| c == Green = "зелен" ++ defaultEnd
| c == Blue = "син" ++ specialAdjectiveEnd g cs
| c == Black = "черн" ++ defaultEnd
| c == White = "бел" ++ defaultEnd
| c == Orange = "оранжев" ++ defaultEnd
| c == Yellow = "желт" ++ defaultEnd
| c == Purple = "фиолетов" ++ defaultEnd
| c == Brown = "коричнев" ++ defaultEnd
| otherwise = show c
where
defaultEnd = defaultAdjectiveEnd g cs
shapeToGender :: Shape -> Gender
shapeToGender s
| s == Pyramid || s == Sphere = Feminine
| otherwise = Masculine
shapeToString :: Shape -> Case -> String
shapeToString s cs
| s == Cube = "куб" ++ nounEnd g cs
| s == Pyramid = "пирамид" ++ nounEnd g cs
| s == Cylinder = "цилиндр" ++ nounEnd g cs
| s == Parallelepiped = "параллелeпипед" ++ nounEnd g cs
| s == Sphere = "сфер" ++ nounEnd g cs
| otherwise = show s
where g = shapeToGender s
Пожалуй, словоформы также следовало бы собирать в Language.Russian.Tiny, чтобы можно было повторно использовать их в будущем. Впрочем, у меня есть идейка (которая лет 50 назад наверняка уже приходила кому-то в голову) по поводу автоматизации сбора словоформ, но этот вопрос выходит за рамки поста.
Проверяем результат
Пример текста, выдаваемого генератором:
На сцене находятся: параллелепипед коричневого цвета, пирамида, окрашенная в синий цвет, пирамида желтого цвета. Переставляем фигуру, находящуюся после пирамиды синего цвета и фигуру, находящуюся на позиции 2. Убирается параллелепипед коричневого цвета. Помещаем на правом краю сцены тяжелую зеленую сферу. На сцене находятся: пирамида желтого цвета, синяя пирамида, крашеная зеленым цветом сфера.
Людям, конечно, не очень интересно читать такой текст, но он осмысленный, уникальный и, если не считать пары огрех с запятыми, грамотный. В некоторых случаях происхождение текста выдает частота использования слова «параллелепипед» и некоторые другие признаки, но это лечится путем усложнения модели. Можно ввести больше цветов, форм и действий, добавить объектам новое свойство. Таким свойством может быть температура или материал, из которого сделана фигура. Наконец, можно найти предметную область поинтереснее.
Где это можно использовать?
Приведенный генератор, конечно, имеет малую практическую ценность. Зато он доказывает, что идея, положенная в его основу, оказалась рабочей. Во всяком случае, более рабочей, чем, скажем, обучение генератора на основе цепей Маркова с помощью генетических алгоритмов. Эта идея тоже интересная, но совершенно не ясно, какую целевую функцию использовать.
Несколько программ, в которых можно применить идею, описанную в этой заметке:
- Генератор обзоров сайтов, фильмов или цифровой техники. За базой знаний в последнем случае идем на Яндекс.Маркет или Товары@Mail.ru. Обзоры продаем на биржах статей или размещаем на тематическом сайте.
- «Помощник копирайтера», то есть слабенький генератор статей любой тематики. Результат работы такого генератора нужно будет доводить до ума вручную, но он, тем не менее, будет экономить копирайтеру несколько минут времени. Идея полностью автоматической генерации статей любой тематики кажется мне несколько утопичной.
- Генератор спама. К сожалению.
- Капча в стиле «C цифрами, изображенными на картинке, выполнили такие-то действия. Что получилось в итоге?»
- Генератор историй об успешной раскрутке сайтов, схем раскрутки/монетизации, подборок «интересно почитать» или финстрипов. Только представьте — можно будет автоматизировать ведение 95% сео-блогов! Впрочем, у меня есть серьезные подозрения, что тут нас с вами опередили.
- Бот, задающий не совсем тривиальные вопросы на вашем форуме и кидающий ссылки на них в своем Twitter-микроблоге. В свободное время этот же бот может слегка троллить форумчан.
- Генератор рассказов о космосе и инопланетянах, историй в стиле фэнтези, квестов в компьютерных играх, сценариев для голливудских боевиков или, на худой конец, обыкновенных гороскопов.
Хотелось бы ознакомиться с вашими мыслями по поводу написанного.
Дополнение: Пишем генератор уникальных статей на Erlang
Метки: Haskell, Искусственный интеллект, Функциональное программирование.
Вы можете прислать свой комментарий мне на почту, или воспользоваться комментариями в Telegram-группе.