Учебник по Haskell

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 :&

...