Функция 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
Вычислим поток всех простых чисел. Мы будем вычислять его по алгоритму “решето Эратосфена”. В