究极数据结构 Finger Tree

“究极数据结构” Finger Tree

前言

写这篇文章的动机是什么

众所周知,代数数据结构 (ADT) 的代表之一 list 的随机访问时间复杂度是 $O(n)$ ,非常的慢。可以说,除了访问/删除/插入头节点以外,几乎所有的操作都是 $O(n)$ 的。虽然说我们写 Haskell 不是在效率上面非常苛求,让它跑的跟c一样快,但每次取个 length 就要 $O(n)$ 的时间还是无法让人放心。于是我们想出了各种方法来优化它的访问时间,比如我们可以通过把 list 封装成函数来使连接的效率达到 $O(1)$ ,我们把它叫做 DList ; 或者通过 Zipper 来提高对内部元素的访问效率,我们把它叫做 list-zipper 。但在学习 Haskell 时,我们了解到它的 Seq 模组中提供了一个效率非常理想的数据结构,名字很奇特,叫做 “ Finger Tree ”,于是看了一点它的源码和最初的 paper 。网上关于 Finger Tree 的中文资料少得可怜(就像很多 Haskell 相关的东西一样),知乎上聚集了一些精通 plt 的人士经常回答这些方面的问题,这次也如往常一样给了我很大的帮助。所以我下面将会讲一点 Finger Tree 相关的知识。

这篇文章讲了什么

我将会在这篇文章中提到 Finger Tree 的设计思想、Finger Tree 的实现细节、 Finger Tree 的应用等内容。

我需要看这篇文章吗

你需要对数据结构有着简单的了解。如果你希望能看懂代码的话,那么需要对 Haskell 的语法和思想有着基本的了解。

为什么是 Finger Tree

它提供了高效的各种序列操作:

Finger-Tree-Performance

它在很多方面几乎达到了理论上的极限,这也是我们为什么在很多地方要使用 Finger Tree 来作为储存序列的东西。

Finger Tree

在讲 Finger Tree 之前我们需要确保大家知道 Monoid 这个东西。

如果你对 Monoid 很熟悉你可以跳过这一段。

什么是 Monoid

可能它的中文名你听说过,它叫 “幺半群”(这个名词也出现在了一个经典笑话中)。我们这里直接给出它在 Haskell 中的定义

1
2
3
class Monoid a where
mempty :: a
mappend :: a -> a -> a

mempty 就是名字中的 “幺元” ,而 mappend 对应着 “群” 所包含的二元运算符。memptymappend 满足下面的关系

1
2
mempty `mappend` a = a
a `mappend` (b `mappend` c) = (a `mappend` b) `mappend` c

这里我们为什么会提到 Monoid 呢,我们将会从树的表示开始谈起。

我们在 Haskell 中如何表示一颗二叉树?

这很简单,像这样就可以了

1
2
3
data Tree a 
= Nil
| Tree (Tree a) a (Tree a)

当然我们也可以这样写(这样写)

1
2
3
data Tree a
= Leaf a
| Tree (Tree a) (Tree a)

我们可以发现第二种树是无法表达“空树”这个概念的,而且我们每次访问树上的值都需要到达叶子结点才能取到值。

这两种表示方法的共同点在于,我们可以定义如下的数据类型

1
2
3
4
5
6
data Node v a 
= Nil a
| Node (Node v a) v (Node v a)
data Tree v a
= Empty
| Tree (Node v a)

于是第一种树我们可以写成 type Tree1 a = Tree a ()

第二种树我们可以写成 type Tree2 a = Node () a

所以通过 v 这个添加的”数据域”,我们可以做很多新文章。

而这个值需要满足树在合并时的一些性质,比如空树不会影响别的和它合并的树的值,而且在树沿着路径下降时计算这些值的话我们要让它们保留结合性。

所以这个 v 应该 是一个 Monoid

那我们回到 Finger Tree

Finger Tree 是什么

2-3 Finger Tree ,我们也可直接称作 Finger Tree,是一种特殊形式的 2-3 树(也就是最简单的 B树)。这里不会有详细的 2-3 树教程。

2-3 树由 2-3 树结点构成

1
2
3
data Node a 
= Node2 a a
| Node3 a a a

我们可以定义 (深度一致的) 2-3 树为

1
2
3
data Tree a
= Zero a
| Succ (Tree (Node a))

画下来大概是这个样子(这是 paper 上的图):

2-3Tree

我们需要高效地访问头尾结点,所以我们需要一些手段来缩短头尾结点到根结点的路径长度。于是我们把最左边和最右边的两个子树翻到根结点上面,得到了这样的一个东西(这也是 paper 上的图):

finger-tree1

(你搜 Finger Tree 基本就能看到这张图,它展现了 Finger Tree 的基本思想)

我们把翻上去的两个结点粘起来,就得到了 Finger Tree (差不多是的)。

其中被粘起来的结点我们把它们叫做 Deep ,被翻上去的叫做 Digit

下面有一些 Finger Tree 的示例图片

Example0

Example1

Example2

所以我们有

1
2
3
4
5
6
data FingerTree a 
| Empty
| Single a
| Deep (Digit a) (FingerTree (Node a)) (Digit a)

type Digit a = Digit [a]

为了防止 Digit 过大/过小 限制了访问/调整 速度,我们使 Digit 的大小始终在 1 ~ 4 之间。

下面我们就可以开始实现 Finger Tree 的各种操作了。

Finger Tree 上的操作

头尾插入单个结点

第一个是 push-front 和 push-back ,即从头/尾插入

(使用 Fira-Code 可以达到更好的符号显示效果,所以这里我选择贴图而不是代码)

push-front :

finger-tree-push-front

在插入时我们优先插在 Digit 上,当 Digit 满了我们会把 Digit 分裂并向下一级插入一个新的 Node 结点。每向下一级需要的 a 的数量会翻 $3$ 倍,所以插入这个过程是均摊 $\Theta(1)$ 的。

头尾删除单个结点

然后是删除头/尾结点。可以由对称性,这个过程也应该是 $\Theta(1)$ 的。

我们实现了一个数据类型 View (实际上是可以使用 Maybe 的)来储存删除的结果

1
2
3
data ViewL s a 
= Nil
| Cons a (s a)

然后有

1
2
3
4
viewL :: FingerTree a -> ViewL FingerTree a
viewL Empty = Nil
viewL (Single a) = Cons a Empty
viewL (Deep (Digit l) m r) = Cons (head l) (deepL (tail l) m r)

这里的 deepL 是处理左 Digit 不一定存在时的 Finger Tree 构造函数

1
2
3
4
5
6
7
8
9
deepL :: 
[a] ->
FingerTree (Node a) ->
Digit a ->
FingerTree a
deepL [] m (Digit r) = case viewL m of
Nil -> toTree r
Cons a as -> Deep (nodeToDigit a) as (Digit r)
deepL l m r = Deep (Digit l) m r

如果为空,就再从中间的子树中分离出一个结点(但在这里是 Node a),转化为 Digit 后再放在左边。

有了 viewL 我们就能得到诸如 headL , tailL 这样的函数。

到这里我们就已经拥有一个合格的 Deque 了,我们不妨封装一下

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
newtype Deque a = Deque (FingerTree a)

pushFront :: a -> Deque a -> Deque a
pushFront a (Deque xs) = Deque (a <| xs)

pushBack :: Deque a -> a -> Deque a
pushBack (Deque xs) a = Deque (xs |> a)

popFront :: Deque a -> View Deque a
popFront (Deque xs) = case viewL xs of
Nil -> Nil
Cons a as -> Cons a (Deque as)

popBack :: Deque a -> View Deque a
popBack (Deque xs) = case viewR xs of
Nil -> Nil
Cons a as -> Cons a (Deque as)

看上去还不错。

但还不够,我们需要让两个 Finger Tree 连起来。

把两棵 Finger Tree 连起来

考虑两个 Finger Tree , Deep l1 m1 r1Deep l2 m2 r2 ,我们需要把它们拼起来。

自然的想法就是把 l1r2 拿出来,把剩下的鼓捣在一起再组装一次。

那么我们需要这样一个函数:

1
2
3
4
5
6
appendDigits :: 
FingerTree (Node a) ->
Digit a ->
Digit a ->
FingerTree (Node a) ->
FingerTree (Node a)

但事实上我们可以把 Digit 都塞到一起(因为它们本质上还是 [a]),来组成一些 Node a ,这样我们只需要实现这样两个函数:(conc for concat)

1
2
conc :: FingerTree a -> [a] -> FingerTree a
nodes :: [a] -> [Node a]

第二个函数的实现其实很显然,每隔 2 / 3 个元素切一刀就好了。

1
2
3
4
5
nodes [a, b] = [Node2 a b]
nodes [a, b, c] = [Node3 a b c]
nodes [a, b, c, d] = [Node2 a b, Node2 c d]
nodes (a: b: c: xs) = Node3 a b c : nodes xs
nodes _ = error "What the fuck??"

第一个函数则有一些细节需要考虑。

当其中一颗树是空树时,我们可以直接把 list 中的元素一个一个塞进去(这个函数的调用者传进来的 list 大小是常数,所以不会影响时间复杂度)。

当两颗树都是 Deep 时,情形和直接连接两颗树差不多,只需要把 l2r2 和加进来的 list 一起转成 list 就行了。

所以 conc 的实现也就很自然了

1
2
3
4
5
6
conc Empty as xs = listConTree as xs
conc xs as Empty = treeConList xs as
conc (Single x) as xs = x <| listConTree as xs
conc xs as (Single x) = treeConList xs as |> x
conc (Deep l1 m1 (Digit r1)) as (Deep (Digit l2) m2 r2) =
Deep l1 (conc m1 (nodes (r1 ++ as ++ l2)) m2) r2

~listConTree和treeConList是两个辅助函数,暴力地把list中的东西一个一个塞到树里~

于是我们可以有:

1
2
3
infixl 5 ><
(><) :: FingerTree a -> FingerTree a -> FingerTree a
a >< b = conc a [] b

显然的,每一次我们调用 conc 时的 list 的长度不会大于 $4$,所以每次调用是均摊 $\Theta(1)$ 的 ,而每一次会使两颗树向下一层,在其中一颗树触底时递归结束,所以递归层数不会超过 $\Theta(\log(\min{n_1, n_2}))$ 。

好的,我们的树现在可以实现 concat 了,めでたしめでたし

实现其它操作的基础

但上面的数据结构也仅仅只能做到这一步了,如果想要实现其它的功能,我们需要为它加上标注 (Annotations )。

我们重写 Finger Tree 的各组成部分并添加标注:

1
2
3
4
5
6
7
8
data Node v a
= Node2 v a a
| Node3 v a a a

data FingerTree v a
= Empty
| Single a
| Deep v (Digit a) (FingerTree v (Node v a)) (Digit a)

注意到我们并没有直接把这里添上一个 Int 或者别的什么来储存它们的大小,我们的 Ultimate Data Structure 不可能这么局限。

为了“用到”我们添加的 v ,我们可以引入一个 type class :

1
2
class Monoid v => Measured a v where
measure :: a -> v

直接写是会报错的,我们需要打开 GHC 扩展

1
{-# LANGUAGE MultiParamTypeClasses #-}

于是我们可以把 Finger Tree 的各部分都实现为 Measured 的一个实例

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
instance Measured a v => Measured (Node v a) v where
measure (Node2 v _ _) = v
measure (Node3 v _ _ _) = v

instance Measured a v => Measured (Node v a) v where
measure (Node2 v _ _) = v
measure (Node3 v _ _ _) = v

instance Measured a v => Measured (Digit a) v where
measure (Digit [a]) = measure a
measure (Digit (a : as)) =
measure a `mappend` measure (Digit as)

instance Measured a v => Measured (FingerTree v a) v where
measure Empty = mempty
measure (Single a) = measure a
measure (Deep v _ _ _) = v

为了简化 mappend 的使用,我们把 Semi Group 中的 <> 借过来用一下

1
2
3
infixl 5 <>
(<>) :: Monoid a => a -> a -> a
(<>) = mappend

然后我们就可以愉快的重写之前的代码了 XD

首先是 Node 的构造函数需要把 v 一并计算(只写 node2):

1
2
node2 :: Measured a v => a -> a -> Node v a
node2 a b = Node2 (measure a <> measure b) a b

Deep 也一样

1
2
3
4
5
6
deep :: Measured a v => 
Digit a ->
FingerTree v (Node v a) ->
Digit a ->
FingerTree v a
deep l m r = Deep (measure l <> measure m <> measure r) l m r

其它的部分也没有很多变化,照着写即可。

把树分裂成两棵

有了 Measured 我们就能够实现 split 了。为了合理的表示 split 的结果,我们定义这么一个数据结构

1
data Split s a = Split (s a) a (s a)

Split 的三个数据域分别存放 split 目标的左侧部分、目标、右侧部分。

假设给出一个函数 f :: v -> Bool ,它在越过树上的某个结点之前一直为 False ,越过之后一直为 True 。我们将利用这个函数来把一棵 Finger Tree 分成 3 部分。

我们要实现这么一个函数:

1
2
3
4
5
splitTree :: Measured a v =>
(v -> Bool) ->
v ->
FingerTree v a ->
Split (FingerTree v a) a

显然的,我们不应该在一棵空树上 split ,所以

1
splitTree _ _ Empty = error "You should not split on an empty"

Single 的话很简单,问题就在于 Deep 该如何处理

分 $3$ 种情况,分界点在左 Digit 上、分界点在子树上、分界点在右 Digit 上。$1$ , $3$ 实际上是一种,我们放在一起考虑。

如果分界点在 Digit 上,我们可以单独使用一个函数来处理这种情形

1
splitDigit :: Measure a v => (v -> Bool) -> v -> Digit -> Split [] a

因为 Digit 实际上就是个 list ,所以只需要沿着每个结点判断一次就可以了

1
2
3
4
5
6
7
8
splitDigit _ _ (Digit [a]) = Split [] a []
splitDigit f i (Digit (a : as))
| f (i <> measure a) = Split [] a as
| otherwise =
let Split l x r = splitDigit f (i <> measure a) (Digit as)
in
Split (a : l) x r
splitDigit _ _ _ = error "What the fuck ??"

而如果分界点在树上,我们就可以递归调用这个过程,对子树直接使用 splitTree ,会拿到一个 Node a 回来,再把它转成 Digit 并再使用一次 splitDigit 就能拿到那个元素了。

再者就是 splitDigit 拿回来的可能是一个空 list ,所以这里要使用前面提到的 deepLdeepR 来构造新的 Finger Tree

1
2
3
4
5
6
7
8
9
10
11
12
13
splitTree _ _ Empty = error "Split on an empty tree!"
splitTree _ _ (Single x) = Split Empty x Empty
splitTree f i (Deep _ l m r)
| f iml = let Split l' x r' = splitDigit f i l in
Split (toTree l') x (deepL r' m r)
| f imm = let Split l' xs r' = splitTree f iml m
Split l'' x r'' = splitDigit f (iml <> measure l') (nodeToDigit xs) in
Split (deepR l l' l'') x (deepL r'' r' r)
| otherwise =
let Split l' x r' = splitDigit f imm r in
Split (deepR l m l') x (toTree r')
where iml = i <> measure l
imm = iml <> measure m

于是 split 也很显然了

1
2
3
4
5
6
7
8
9
split :: Measured a v =>
(v -> Bool) ->
FingerTree v a ->
(FingerTree v a, FingerTree v a)
split _ Empty = (Empty, Empty)
split f xs
| f (measure xs) = (l, x <| r)
| otherwise = (xs, Empty)
where Split l x r = splitTree f mempty xs

在整个序列都不满足条件的时候我们直接返回空树

它的时间复杂度与合并两颗 Finger Tree 类似,也是均摊 $\Theta(\log(\min{n,n - m}))$

到这里我们大概就能实现一个 Data.Seq

下标访问

为了提供 Seqindex 功能,我们需要为它定制一个 Monoid 来实现取 size 的功能

1
newtype Sized = Size {getSize :: Int} deriving(Eq, Ord)

然后我们可以有:

1
2
3
instance Monoid Sized where
mempty = Size 0
Size a `mappend` Size b = Size $ a + b

然后可以把它套到 Measure 上,但这里我们需要对 Seq 的原始数据进行一次封装

1
2
newtype Elem a = Elem {getElem :: a}
newtype Seq a = Seq (FingerTree Size (Elem a))

然后实现 Measureinstance

1
2
instance Measure (Elem a) Sized where
measure _ = Size 1

于是在 FingerTree Size (Elem a) 的数据域中,存放的就是当前树的大小,所以我们可以轻松地实现 length

1
2
length :: Seq a -> Int
length (Seq xs) = getSize $ measure xs

还记得我们之前实现的 FingerTree v a 作为 Measure 的实例吗,在这里就派上了用场。

然后是 splitAt ,在特定的下标处分离两个序列

1
2
3
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt i (Seq xs) = (Seq l, Seq r)
where (l, r) = split (Size i <) xs

在满足 Size i < Size x 之前的一共有 $i$ 个元素,所以就是相当于从 $i$ 处切开。

同时 index 也类似

1
2
3
index :: Seq a -> Int -> a
index (Seq xs) i = getElem x
where Split _ x _ = splitTree (Size i <) mempty xs

实现优先队列

类似于 Sized 这个 Monoid ,我们同样可以借助其它的 Monoid 来使我们的 Finger Tree 支持其它的操作,优先队列就是一个例子。

定义:

1
2
3
4
data Priority a
= MinusInf
| Priority a
deriving(Eq, Ord)

显然,它也是一个 Monoid :

1
2
3
4
5
instance Ord a => Monoid (Priority a) where
mempty = MinusInf
a `mappend` MinusInf = a
MinusInf `mappend` a = a
(Priority a) `mappend` (Priority b) = Priority (a `max` b)

当它用在 Finger Tree 上时表示一个区间上的最大值,我们可以定义:

1
newtype PriorityQueue a = PQ (FingerTree (Priority a) (Elem a))

然后定义 Measuredinstance

1
2
instance (Ord a) => Measured (Elem a) (Priority a) where
measure (Elem a) = Priority a

作为优先队列它可以随意从前面或者后面插入,当删除最大结点时只需要利用 splitTree 找到最大结点把它拿出来即可

1
2
3
pop :: Ord a => PriorityQueue a -> (a, PriorityQueue a)
pop (PQ q) = (x, PQ (l >< r))
where Split l x r = splitTree (measure q <=) mempty q

实现有序序列

如果再换一个 Monoid 实现,我们又能得到一个类似于有序列表的东西

1
2
3
4
5
6
7
8
9
10
data Key a 
= None
| Key a
deriving(Eq, Ord)

instance Monoid (Key a) where
mempty = None
None `mappend` None = None
a `mappend` None = a
_ `mappend` a = a

Monoid Key 会优先选择右边的东西,在(默认升序的)有序序列中就是最大的那个。

然后我们定义

1
2
3
4
newtype Set a = Set (FingerTree (Key a) (Elem a))

instance Measured (Elem a) (Key a) where
measured (Elem a) = Key a

同样是依赖于 split ,我们可以实现根据一个元素来划分序列的函数:

1
2
3
partition :: Ord a => a -> Set a -> (Set a, Set a)
partition k (Set xs) = (Set l, Set r)
where (l, r) = split (>= Key k) xs

于是我们可以实现 Set 的插入和删除

1
2
3
4
5
6
7
8
insert :: Ord a => a -> Set a -> Set a
insert x (Set xs) = Set (l >< (Elem x <| r))
where (l, r) = split (>= Key x) xs

delete :: Ord a => a -> Set a -> Set a
delete x (Set xs) = Set (l1 >< r2)
where (l1, r1) = split (>= Key x) xs
(_ , r2) = split (> Key x) r1

合并两个 Set 可以用启发式合并,具体的思路是每次取出其中一棵树的最小值,然后以其为基准把另一棵树分开,随即将“左半部分和该最小值”与“右半部份和取出最小值后剩下的部分继续合并的结果”连接起来。

1
2
3
4
5
6
merge :: Ord a => Set a -> Set a -> Set a
merge (Set xs) (Set ys) = Set (mergeSet xs ys)
where mergeSet as bs = case viewL bs of
Nil -> as
Cons b bs' -> l >< (b <| mergeSet bs' r)
where (l, r) = split (> measure b) as

时间复杂度是 $\Theta(m\log(n/m))$ 其中 $n$, $m$ 分别是两棵树中较大/较小的树的大小。

而当一棵树中的元素都小于另外一棵树中的元素时,我们可以直接使用 Finger Tree 的 concat ,时间复杂度为 $\Theta(\log m)$

继续扩展

大家应该能看出来 Finger Tree 的使用和线段树有很多相似的地方,比如真正的数据只在叶结点上存在,这样用 Finger Tree 来维护区间也是很轻松的事情。所以只需要针对需求调整相应的 Monoid ,就能用 Finger Tree 来维护各种各样的东西。

实现细节

事实上,Digit 我们使用的是 list 来实现的,这肯定会带来一些效率上的问题,所以在库中,Digit 都是这么定义的

1
2
3
4
5
data Digit a
= One a
| Two a a
| Three a a a
| Four a a a a

这会带来很可怕的代码膨胀,尤其是在实现 appendTree 这个函数时。

首先我们需要的是

1
2
3
4
5
6
addDigits :: Sized a => 
FingerTree (Node a) ->
Digit a ->
Digit a ->
FingerTree (Node a) ->
FingerTree (Node a)

$4$ 种 Digit ,有两个,共有 $16$ 种情形,每种都要写一个。

而不同的 Digit 揉在一起的 Node 数量也不一样,所以也需要像这样的函数

1
2
3
4
5
appendTree' :: 
FingerTree (Node a) ->
Node a ->
FingerTree (Node a) ->
FingerTree (Node a)

而它的实现又不可避开一个这样的函数:

1
2
3
4
5
6
7
addDigits' :: 
FingerTree (Node (Node a)) ->
Digit (Node a) ->
Node a ->
Digit (Node a) ->
FingerTree (Node (Node a)) ->
FingerTree (Node (Node a))

而它又依赖另外一个:

1
2
3
4
5
6
appendTree'' :: 
FingerTree (Node a) ->
Node a ->
Node a ->
FingerTree (Node a) ->
FingerTree (Node a)

如此循环往复,直到参数中间包含 $4$ 个 Node

这些全部实现下来大概有 200 行……我放一张 code map 缩略图给大家看一下

code-map

还有就是在真正实现高性能 Haskell 代码时,不可避免的要涉及到 Strictness, 、Unpack 之类的东西,例如在 Data.Seq 中实现的 Finger Tree, 就使用了 Strictness flag 来防止不必要的延迟求值,并使用了 unpack 来提升性能

1
2
3
4
data FingerTree a
= Empty
| Single a
| Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)

在这里也不加赘述。

你看完了这篇文章

你学到了什么

可能学到了一点 Haskell 实现数据结构的姿势,以及神奇的 $\Theta(\log n)$ 合并的平衡树的写法,出去可以与小伙伴们吹逼。

你觉得这篇文章可能有很多问题

欢迎指正

参考文献

Finger Tree 的维基百科

Finger Tree 的 hackage 源码

Finger Tree 的论文 (推荐阅读)

Paper 的网站