Pull to refresh

Катаморфизм в F#

Reading time 9 min
Views 6.8K

Введение


Упомяну сразу, данная статья написана по мотивам целой серии постов в отличном блоге Inside F#. Тем не менее она не является переводом в чистом виде, а скорее вольным изложением, чтобы доступным языком объяснить — что же за зверь такой, катаморфизм, и с чем его едят. Слово это думаю не очень на слуху, чего стоит хотя бы тот факт, что статьи по нему нет в русской википедии (и вообще ни в одной национальной, кроме почему-то голландской. Наверно ФП как-то соответсвует духу травокурения)
Итак, строго говоря, катаморфизм в функциональном программировании — это обобщение свертки списков, которые (как я уже рассказывал) являются специфическим типом размеченного объединения, на произвольные размеченные объединения.

Свертка списков


Начнем по порядку — со свертки списков. Собственно мы уже знаем, что это такое и как ее использовать, но для того, чтобы распространить ее на другие типы данных, нам еще надо понять, как она осуществляется.
Вот стоит перед нами задача — просуммировать элементы списка. А как вы знаете в СССР секса нет в ФП циклов нет. (Есть конечно, но мы об этом никому не скажем). Вариант List.fold_left (+) 0 официально объявляется читерским. Что же приходит на ум? Ну вот так (в стиле горячо любимых преподавателями примеров рекурсии для Фибоначчи или факториала):
let rec sum list =
    match list with
    |[] -> 0
    |head::tail -> head + sum tail

Нет друзья, это конечно решение, но будем честны перед собой — хвастаться тут нечем. Потому что при длине цикла скажем, миллион, компилятор выдаст нам System.StackOverflowException, и будет тысячу раз прав — нельзя так над ним издеваться. Окей, перепишем это дело в виде хвостовой рекурсии:
let sum_tail list =
    let rec loop list acc =
        match list with
        |[] -> acc
        |head::tail -> loop tail (acc+head)
    loop list 0

Здесь у нас все вычисления происходят немедленно, так что тащить за собой весь хвост нет компилятору никакой необходимости, что его всегда безумно радует. Ну ладно, а что если нам надо скажем найти длину списка (опять же без метода List.length)? Да нет проблем.
let rec length list =
    let rec loop list acc =
        match list with
        |[] -> acc
        |head::tail -> loop tail (acc+1)
    loop list 0

Думаю, даже не самый наблюдательный читатель может увидеть похожесть двух этих алгоритмов. Разница только в способе обработки аккумуляторного значения. В первом случае мы для каждого рассматриваемого элемента (головы оставшегося куска списка) прибавляем к аккумулятору его значение, во втором — просто единицу. Что это такое по сути? Ничего более чем функция от 'a -> 'b -> 'a, где 'a — тип аккумулятора, 'b — тип элемента списка.
fun acc h -> acc + h (или просто (+)) для первого, fun acc h -> acc + 1 для второго. Свертка списка как раз и является функцией высшего порядка, которая применяет такую функцию ко всем элементам списка, чтобы получить некое атомарное значение. Вот как это выглядит:
// ('a -> 'b -> 'a) -> 'a -> list<'b> -> 'a
let rec fold func acc list =
    match list with
    |[] -> acc
    |head::tail -> fold func (func acc head) tail

И очевидно, что:
let sum_tail = fold (+) 0
let length = fold (fun acc _ -> acc + 1) 0

Кстати, не стоит так уж формально относиться к словам о том, что свертка должна возвращать атомарное значение. Взгляните, что делает эта функция?
let reverse = fold (fun acc h -> h::acc) []

Думаю, вы догадались, что она переворачивает список. То есть ее реазультатом тоже является список — такое вот вполне себе атомарное значение.
Ну хорошо, вроде со сверткой разобрались. На самом деле не совсем. Ведь это у нас так называемая левоассоциативная свертка, то есть просмотр элементов и выполнение свертывающей функции на них у нас идет от головы к хвосту. Вот так (f — свертывающая функция): f(… f (acc i0) i1)i2)...ik) А как бы нам сделать правоассоциативную функцию, чтобы было вот так: f i0 (f… (f ik acc)))) (Зачем? Потому что именно от нее будет очень удобно распространять нашу свертку на другие типы данных)
Напишем функцию по аналогии с левоассоциативной сверткой:
let rec fold_right func acc list =
    match list with
    |[] -> acc
    |head::tail -> func head (fold_right func acc tail)

и тут же заметим, что теперь у нас рекурсия осуществляется внутри вычисления функции, так что компилятору волей-неволей придется тащить ее в стек, короче, прости-прощай хвостовая рекурсия, здравствуй неминуемй stack overflow. Чтобы избежать этого позора нам необходимо каким-то образом добраться до самого конца списка, запоминая при этом последовательность элементов в обратном порядке, чтобы их свертывать. Но не в стеке же конечно этим заниматься, как в вышеприведенном примере, а в какой-нибудь структуре данных. Простейший способ очевиден — развернуть список, а потом применить на нем левоассоциативную свертку. При этом нашей вспомогательной структурой будет инвертированный список. Все просто и очевидно.
Однако мы пойдем другим путем. В качестве вспомогательной структуры мы будем использовать функцию континуации. Что это такое? — Это такая функция, которая содержит в себе весь необходимый ход вычислений, но не производит, заметьте, сами вычисления, пока мы ей на это специально не укажем. Вот такую функцию мы хотим получить: cont x = f i0 (f… (f ik x)))), все строго согласно определению. В нужный момент она примет в качестве параметра начальное значение аккумулятора и все разом посчитает, как велено. Замечательная функция, не правда ли? Осталось ее получить:
let fold_right func acc list =
    let rec loop list cont = //сюда мы передаем текущую функцию континуации
        match list with
        |[] -> cont acc //а вот и наше ключевое вычисление.
        |head::tail -> loop tail (fun racc -> cont (func head racc))
    loop list (fun x -> x)

Заметьте, что теперь функция стала вновь хвостово-рекурсивной, все вычисления производятся безотлагательно, и в следующий шаг рекурсии передается их результат — обновленная функция континуации. И еще, на протяжении всей работы функции, пока список не исчерпается, acc равен начальному значению, то есть называться аккумулятором он уже как-то и не достоин. Скорее это init_value. А сама функция континуации от шага к шагу меняется вот так:
0: x -> x
1: x -> f i0 x
2: x -> f i0 (f i1 x)
3: x -> f i0 (f i1 (f i2 x))

думаю далее расписывать ход вычислений нет необходимости. Подставив вместо x начальное значение мы получим ровно то, что и хотели.
Что ж, мы разобрались со свертками списков. Правда, пока не понятно, к чему было огород городить, но скоро вы все поймете.

Свертка деревьев


Итак, как упомянуто во введении, катаморфизм — это обобщение свертки списков на любые алгебраические типы, или размеченные объединения, как они называются в F#. (Как вы помните, список — тоже размеченное объединение)
А теперь рассмотрим вот такое размеченное объединение:
type Tree<'a> =
    | Node of 'a * Tree<'a> * Tree<'a>
    | Leaf

Это у нас, как не сложно догадаться, бинарное дерево, у которого есть осмысленные узлы (кортеж, описывающий его, представляет собой значение и две ветви), и листы-заглушки, употребление которых в кортеже узла просто означает, что данной ветви у него нет.
Вот пример такого дерева:
let tree = Node(4, Node(2,Node(1, Leaf,Leaf),Node(3,Leaf,Leaf)),Node(6,Node(5, Leaf,Leaf),Node(7,Leaf,Leaf)))

А теперь нам очень хочется на этом дереве выполнить некоторые вполне жизненные операции: найти сумму всех значений, или найти высоту, ну и в список растянуть было бы нелишним. Наивные рекурсивные решения этих задач столь же неудобоваримы, как и подобные им на списках.
К примеру, простейший способ разложения в список
let rec to_list tree =
    match tree with
    |Node(v, ltree, rtree) -> (to_list ltree)@[v]@(to_list rtree)
    |Leaf -> []

Этот метод мало того, что опять может привести к переполнению стека, так еще вдобавок использует функцию конкатенации списков, которая, скажем по секрету, очень неэффективно их обрабатывает. Так у нас дела не пойдут.
Но ведь не зря мы, в конце концов, так долго мучались, пока не написали fold_right с применением функции континуации. Это было неспроста. Данный способ очень хорошо применим и для дерева.
Примечание: А сейчас, если у вас в домашней аптечке случайно завалялись препараты, расширяющие сознание, не сочтите за труд, сходите, выпейте таблеточку. Может пригодится.
В чем заключается отличие дерева от списка? Появилась просто-напросто вторая ветвь для каждого узла. То есть, на каждом шаге нашей свертки у нас будет образовываться не один, а два хвоста, а значит и функция свертки должна иметь вид: 'b -> 'a -> 'a -> 'a, где второй и третий аргумент ее обозначают аккумуляторы для левого и правого хвостов. Такой будут функции свертки для суммирования и поиска высоты:

fun x left right -> x + left + right
fun _ left right -> 1 + max left right

Попробуем. Поскольку у нас на каждом этапе есть две возможности продолжения просмотра, то и вложенный цикл должен быть двойной. Как это сделать применительно к нашей функции континуации? — очень просто:

let FoldTree treeF leafV tree =
    let rec loop tree cont =
        match tree with
        |Node (val, left, right) -> loop left (fun lacc ->
                           loop right (fun racc ->
                           cont (treeF val lacc racc)))
        |Leaf -> cont leafV
    loop tree (fun x -> x)

Как видим, здесь по сути на каждом шаге есть две функции континуации — одна накапливает значение для левого поддерева, вторая, внутренняя — для правого, после чего все это фолдится с помощью функции treeF. При попадании в лист мы применяем накопленную нами для текущего поддерева функцию к начальному значению, соответсвующему листьям — leafV.
Можно заметить, что пока мы будем перебирать значения левого поддерева, в функции континуации будут накапливаться рекурсивные вызовы к loop для правых поддеревьев, однако именно что в функции, а не в стеке, так что и с точки зрения «хвостовости» здесь все хорошо.
Вот как это выглядит для нашего дерева:
                            4
                        2         6
                      1    3   5   7
4: x -> x
2: x -> loop (6,5,7) (y -> treeF 4 x y)
1: x -> loop (3) (y -> loop (6,5,7) (z -> treeF 4 (treeF 2 x y) z))
Ll: x -> loop Lr (y -> loop (3) (z -> loop (6,5,7) (q -> treeF 4 (treeF 2 (treeF 1 x y) z) q)))

Здесь Ll — это левый лист, Lr — правый. Попав в лист мы должны применить функцию к начальному значению, а значит — и выполнить вдобавок самый внешний loop.
Lr: y -> loop (3) (z -> loop (6,5,7) (q -> treeF 4 (treeF 2 (treeF 1 leafV y) z) q))

Проделываем ту же операцию для правого листа и получаем:
3: z -> loop (6,5,7) (q -> treeF 4 (treeF 2 (treeF 1 leafV leafV) z) q)

Заметьте, что сейчас (treeF 1 leafV leafV) — это уже не функция, а значение, т.е. для крайнего левого дерева (того, которое просто 1) фолд уже произведен. Дальше все происходит таким же образом, думаю, читатель может представить, как.
Теперь желаемые нами операции выглядят следующим образом:
let SumTree = FoldTree (fun x left right -> x + left + right) 0
let HeightTree = FoldTree (fun _ left right -> 1 + max left right) 0
let Tree2List = FoldTree (fun x left right -> left @ [x] @ right)

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

Свертка на обобщенных размеченных объединениях


Напоследок рассмотрим катаморфизм на другом любопытном типе размеченных объединений, задающем, условно говоря, некоторый язык программирования:
type Op =
    |Plus
    |Minus
    override this.ToString() =
        match this with
        |Plus -> "+"
        |Minus -> "-"

type Expr =
    |Literal of int
    |BinaryOp of Expr*Op*Expr
    |IfThenElse of Expr*Expr*Expr

В данном случае это очень простой язык вычисления математических выражений, снабженный дополнительно условным оператором (для простоты будем считать, что любое ненулевое значение выражения в условии соответствует true). Пример такого выражения:
let expr = IfThenElse (Literal 1, BinaryOp (Literal 12, Minus, Literal 10), Literal 32)

Что бы нам хотелось сделать с этим выражением? Ну например, вывести его в удобоваримой форме:
if 1 then (12 - 10) else 32 endif

а еще — собственно посчитать результат, здесь это будет 2. Что нам поможет одновременно решить две эти вроде бы не похожие задачи? — правильно, катаморфизм. Думаю, после примера на деревьях, написать свертку для этого типа будет совсем не сложно. Нам нужно иметь кроме самого выражения еще три функции-аргумента — по одной на каждый тип выражения. Напишем для нее функцию свертки:
let FoldExpr funL funB funIf expr =
    let rec loop expr cont =
        match expr with
        |Literal x -> cont (funL x)
        |BinaryOp (left,op,right) -> loop left (fun lacc ->
                              loop right (fun racc ->
                              cont (funB lacc op racc)))
        |IfThenElse (condExp,thenExp,elseExp) -> loop condExp (fun cacc ->
                               loop thenExp (fun tacc ->
                               loop elseExp (fun eacc ->
                               cont (funIf cacc tacc eacc))))
    loop e (fun x -> x)

Посмотрите, ровным счетом ничего нового по сравнению с деревьями, разве что при рассмотрении IfThenElse у нас аж три вложенных цикла, но это и неудивительно, ведь нам надо развернуть как условие, так и две возможные ветви продолжения. Функции funL, funB, funIf служат для обработки литералов, бинарных операций и условных операторов соотвественно.
Теперь мы можем спокойно написать обе нам необходимые функции. Так мы выведем в строку выражение (кстати заметьте, что мы не зря переопределили в типе Op метод ToString():
let Printer =
    FoldExpr (fun x -> sprintf "%d" x) //обработка литералов
             (fun l op r -> sprintf "(%s %s %s)" l (op.ToString()) r) //обработка бинарных операторов
             (fun c t e -> sprintf "if %s then %s else %s endif" c t e) //обработка условных операторов

Ну а теперь собственно «компилятор»:
let Eval =
    FoldExpr (fun x -> x)
             (fun l op r -> match op with |Plus -> l + r |Minus -> l - r)
             (fun c t e -> if c > 0 then t else e)

Как видите, функции обработки очень просты и интуитивно понятны.
Конечно, сам тип Expr в данном примере не очень сложный, однако на самом деле с помощью размеченных объединений можно реализовать довольно замысловатые «ЯП», ну и далеко не только «ЯП», естественно. А уж свертка на таком размеченном объединеннии с большой вероятностью будет незаменимым орудием на все случаи жизни. Такой вот катаморфизм.
P.S. Не знаю, стоит ли переносить в какой-то коллективный блог, все-таки тема специфическая.
UPD: Долго выбирал, куда перенести, решил в .Net, как наиболее нейтральный.
Tags:
Hubs:
+11
Comments 24
Comments Comments 24

Articles