Сказка про репку как набор (ката-,ана-)морфизмов над списками

[dastapov]

Этот пост был написан "в стол" и долгое время там лежал. В процессе переезда обычно наводишь порядок, в том числе - и в столе. Ненужное выкидываешь, нужно - приспосабливаешь для какой-то пользы. Раз уж пост был написал - надо его публиковать :)

О чем повествует сказка про репку, вы все наверняка в курсе.

Если кто забыл - напомню:

> module Main where

> import Prelude hiding (putStrLn, print)
> import System.IO.UTF8
> import Data.List (intersperse, find)

Вы скажете - в сказке такого не было? Погодите - скоро сказка сказывается, не скоро дело делается. Так вот, жили-были любители репы:

> едоки :: Едоки
> едоки = [ "дедка", "бабка", "внучка", "жучка", "кошка", "мышка" ]

> type ЛюбительРепы = String
> type Едоки = [ЛюбительРепы]

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

Вернемся к репке:

> main = do
>   putStrLn "Посадил дед репку. Выросла репка большая-пребольшая. Пришло время ее тянуть ..."
>   тянуть

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

> подходы :: [ Едоки ]
> подходы = scanl зазвать [] едоки
>   where зазвать толпа подмога = подмога:толпа

Выстроившись по старшинству, по команде "Взялись!" они брались за впереди стоящего:

> взялись :: Едоки -> [ (ЛюбительРепы, ЛюбительРепы) ]
> взялись едоки = zip едоки' ("репка":едоки')
>   where едоки' = reverse едоки -- а не то дед будет тянуть самым последним

, и получалась такая вот диспозиция: дедка - за репку, бабка - за дедку ... Тянут-потянут! ... Ну, всем известно, что до прихода мышки репка не вытягивается. Попробуем это описать:

> описать ситуация 
>   | null ситуация = ""
>   | otherwise     = unwords [ "Взялись:"
>                             , concat $ intersperse ", " $ map за ситуация
>                             , ". Тянут-потянут -- " ++ что_же_получилось
>                             ]
>   where 
>     за (кто,кого) = кто ++ " за " ++ винительный_падеж кого
>     винительный_падеж ы = init ы ++ "у"
>     что_же_получилось = if elem "мышка" (map fst ситуация)
>                            then "вытянули репку!"
>                            else "вытянуть не могут!"

Сказка про репку, являющаяся типичным образцом формульной сказки (или сказки с кумулятивной экспозицией), заключается в том, что рассказчик последовательно описывает все диспозиции (хотя правильнее говорить - "экспозиции") вплоть до последней, ставящей точку в нагромождении сюжета:

> тянуть = mapM_ putStrLn $ map (описать.взялись) подходы

Вы прослушали русскую народную сказку про репку в чиста функциональном исполнении. Благодарю за внимание :)

PS
Признавайтесь, кто еще вспомнил попытки "адаптировать" Паскаль для наших школ и приснопамятный "язык РАЯ" (русский алгоритмический язык)?

PPS
Данный пост является программой на literate haskell, которую вы можете невозбранно запустить, полчив такой вот текст:

Посадил дед репку. Выросла репка большая-пребольшая. Пришло время ее тянуть ...

Взялись: дедка за репку . Тянут-потянут -- вытянуть не могут!
Взялись: дедка за репку, бабка за дедку . Тянут-потянут -- вытянуть не могут!
Взялись: дедка за репку, бабка за дедку, внучка за бабку . Тянут-потянут -- вытянуть не могут!
Взялись: дедка за репку, бабка за дедку, внучка за бабку, жучка за внучку . Тянут-потянут -- вытянуть не могут!
Взялись: дедка за репку, бабка за дедку, внучка за бабку, жучка за внучку, кошка за жучку . Тянут-потянут -- вытянуть не могут!
Взялись: дедка за репку, бабка за дедку, внучка за бабку, жучка за внучку, кошка за жучку, мышка за кошку . Тянут-потянут -- вытянули репку!


В коде на Haskell допускается использовать литералы в utf-8, чем я и воспользовался. Для компиляции и запуска кода может понадобится сторонняя библиотека utf8-string (apt-get install libghc6-utf8-string-dev или взять на hackage.haskell.org

PPPS
С точки зрения теории категорий, map - морфизм, zip - катаморфизм, а scanl - анаморфизм списков. Отсюда и заголовок.

Даже и не буду спрашивать, есть ли у вас вопросы ;)