BT reeA = µ( A + I ? I)
Определим потоки:
StreamA = ?( A ? I)
Потоки являются конечным объектом F -коалгебры, где F = A ? I.
16.3 Гиломорфизм
Оказывается, что с помощью катаморфизма и анаморфизма мы можем определить функцию fix, то есть
мы можем выразить любую рекурсивную функцию с помощью структурной рекурсии.
Функция fix строит бесконечную последовательность применений некоторой функции f.
f (f (f … )))
Сначала с помощью анаморфизма мы построим бесконечный список, который содержит функцию f во
всех элементах:
repeat f = f : f : f : …
А затем заменим конструктор : на применение. В итоге мы получим такую функцию:
fix :: (a -> a) -> a
fix = foldr ($) undefined . repeat
Убедимся, что эта функция работает:
Prelude> let fix = foldr ($) undefined . repeat
Prelude> take 3 $ y (1:)
[1,1,1]
Prelude> fix (f n -> if n==0 then 0 else n + f (n—1)) 10
55
Теперь давайте определим функцию fix через функции cata и ana:
fix :: (a -> a) -> a
fix = cata ((Cons f a) -> f a) . ana (a -> Cons a a)
Эта связка анаморфизм с последующим катаморфизмом встречается так часто, что ей дали специальное
имя. Гиломорфизмом называют функцию:
hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)
hylo phi psi = cata phi . ana psi
Отметим, что эту функцию можно выразить и по-другому:
Гиломорфизм | 247
hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b)
hylo phi psi = phi . (fmap $ hylo phi psi) . psi
Этот вариант более эффективен по расходу памяти, мы не строим промежуточное значение Fix f, а сразу
обрабатываем значения в функции phi по ходу их построения в функции psi. Давайте введём инфиксную
операцию гиломорфизм для этого определения:
(>> ) :: Functor f => (a -> f a) -> (f b -> b) -> (a -> b)
psi >> phi = phi . (fmap $ hylo phi psi) . psi
Теперь давайте скроем одноимённую функцию из Prelude и определим несколько рекурсивных функций
с помощью гиломорфизма. Начнём с функции вычисления суммы чисел от нуля до данного числа:
sumInt :: Int -> Int
sumInt = range >> sum
sum x = case x of
Nil
-> 0
Cons a b -> a + b
range n
| n == 0
= Nil
| otherwise = Cons n (n—1)
Сначала мы создаём в функции range список всех чисел от данного числа до нуля. А затем в функции
sum складываем значения. Теперь мы можем легко определить функцию вычисления факториала:
fact :: Int -> Int
fact = range >> prod
prod x = case x of
Nil
-> 1
Cons a b -> a * b
Напишем функцию, которая извлекает из потока n-тый элемент. Сначала определим тип для потока:
type Stream a = Fix (S a)
data S a b = a :& b
deriving (Show, Eq)
instance Functor (S a) where
fmap f (a :& b) = a :& f b
headS :: Stream a -> a
headS x = case unFix x of
(a :& _) -> a
tailS :: Stream a -> Stream a
tailS x = case unFix x of
(_ :& b) -> b
Теперь функцию извлечения элемента:
getElem :: Int -> Stream a -> a
getElem = curry (enum >> elem)
where elem ((n, a) :& next)
| n == 0
= a
| otherwise = next
enum (a, st) = (a, headS st) :& (a—1, tailS st)
В функции enum мы добавляем к элементам потока убывающую последовательность чисел, она стартует
из данного числа. Элемент, который нам нужен, будет содержать в этой последовательности число ноль. В
функции elem мы как раз и извлекаем тот элемент рядом с которым хранится число ноль. Обратите внима-
ние на то, что рекурсия встроена в этот алгоритм, если данное число не равно нулю, мы просто извлекаем
следующий элемент.
С помощью этой функции мы можем вычислить n-тое число из ряда чисел Фибоначчи. Сначала создадим
поток чисел Фибоначчи:
248 | Глава 16: Категориальные типы
fibs :: Stream Int
fibs = ana ((a, b) -> a :& (b, a+b)) (0, 1)
Теперь просто извлечём n-тый элемент из потока чисел Фибоначчи:
fib :: Int -> Int
fib = flip getElem fibs
Вычислим поток всех простых чисел. Мы будем вычислять его по алгоритму “решето Эратосфена”. В
начале алгоритма у нас есть поток целых чисел и известно, что первое число является простым.
2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 …
В процессе этого алгоритма мы вычёркиваем все не простые числа. Сначала мы ищем первое не зачёркну-
тое число и помещаем его в результирующий поток, а на следующий шаг алгоритма мы передаём исходный,
поток в котором зачёркнуты все числа кратные тому, что мы положили последним:
2
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, …
Теперь мы ищем первое незачёркнутое число и помещаем его в результат. А на следующий шаг рекусии
передаём поток, в котором зачёркнуты все числа кратные новому простому числу:
2, 3
4, 5, 6, 7, 8, 9, 10, 12, 13, 14, 15, …
И так далее, на каждом шаге мы будем получать одно простое число. Зачёркивание мы будем имитиро-
вать с помощью типа Maybe. Всё начинается с потока целых чисел, в котором не зачёркнуто ни одно число:
nums :: Stream (Maybe Int)
nums = mapS Just $ iterateS (+1) 2
mapS :: (a -> b) -> Stream a -> Stream b
mapS f = ana $ xs -> (f $ headS xs) :& tailS xs
iterateS :: (a -> a) -> a -> Stream a
iterateS f = ana $ x -> x :& f x
В силу ограничений системы типов Haskell мы не можем определить экземпляр Functor для типа Stream,
поскольку Stream является не самостоятельным типом а типом-синонимом. Поэтому нам приходится опре-
делить функцию mapS. Определим шаг рекурсии:
primes :: Stream Int
primes = ana erato nums
erato xs = n :& erase n ys
where n
= fromJust $ headS xs
ys = dropWhileS isNothing xs
Переменная n содержит первое не зачёркнутое число на данном шаге. Переменная ys указывает на спи-
сок чисел, из начала которого удалены все зачёркнутые числа. Функции isNothing и fromJust взяты из стан-
дартного модуля Data.Maybe. Нам осталось определить лишь две функции. Это аналог функции dropWhile
на списках. Эта функция удаляет из начала списка все элементы, которые удовлетворяют некоторому пре-
дикату. Вторая функция erase вычёркивает все числа в потоке кратные данному.
dropWhileS :: (a -> Bool) -> Stream a -> Stream a
dropWhileS p = psi >> phi
where phi ((b, xs) :& next) = if b then next else xs
psi xs = (p $ headS xs, xs) :& tailS xs
В этой функции мы сначала генерируем список пар, который содержит значения предиката и остатки
списка, а затем находим в этом списке первый такой элемент, значение которого равно False.
erase :: Int -> Stream (Maybe a) -> Stream (Maybe a)
erase n xs = ana phi (0, xs)
where phi (a, xs)
| a == 0
= Nothing
:& (a’, tailS xs)
| otherwise = headS xs :& (a’, tailS xs)
where a’ = if a == n—1 then 0 else (a+1)
Гиломорфизм | 249
В функции erase мы заменяем на Nothing каждый элемент, порядок следования которого кратен аргу-
менту n. Проверим, что у нас получилось:
*Fix> primes
(2 :& (3 :& (5 :& (7 :& (11 :& (13 :& (17 :& (19 :& (23 :& (29 :& (31 :& (37 :& (41 :& (43 :& (47 :& (53 :& (59 :&
(61 :& (67 :& (71 :& (73 :& (79 :& (83 :& (89 :& (97 :&
(101 :& (103 :& (107 :& (109 :& (113 :& (127 :& (131 :&
…
16.4 Краткое содержание
В этой главе мы узнали, что любая рекурсивная функция может быть выражена через структурную ре-
