跳转到内容

F# 编程/高级数据结构

Add links
来自维基教科书，开放世界中的开放书籍
< F# 编程
最新修订版本于 2022年4月29日 审核。目前有 1 个待审核更改。
上一节：主动模式 索引 下一节：反射
F#：高级数据结构

F# 自带了一套数据结构，但了解如何从头开始实现数据结构非常重要。

顺便说一下，数百位作者已经撰写了数千本关于这个主题的冗长书籍，因此在本书有限的空间内提供数据结构的全面概述是不现实的。相反，本章旨在介绍使用 F# 开发不可变数据结构的基础知识。鼓励读者使用本页底部列出的资源来更全面地了解算法和数据结构。

栈

[编辑 | 编辑源代码]

F# 的内置 列表 数据结构本质上是一个不可变的栈。虽然它当然可以使用，但为了编写探索性代码的目的，我们将从头开始实现一个栈。我们可以使用一个简单的联合来表示栈中的每个节点

type 'a stack =
    | EmptyStack
    | StackNode of 'a * 'a stack

使用以下代码很容易创建栈的实例

let stack = StackNode(1, StackNode(2, StackNode(3, StackNode(4, StackNode(5, EmptyStack)))))

每个 StackNode 包含一个值和一个指向列表中下一个栈的指针。结果数据结构可以绘制如下

 ___    ___    ___    ___    ___ 
|_1_|->|_2_|->|_3_|->|_4_|->|_5_|->Empty

我们可以创建如下所示的栈模块模板

module Stack =
    type 'a stack =
        | EmptyStack
        | StackNode of 'a * 'a stack
        
    let hd = function
        | EmptyStack -> failwith "Empty stack"
        | StackNode(hd, tl) -> hd
        
    let tl = function
        | EmptyStack -> failwith "Empty stack"
        | StackNode(hd, tl) -> tl
        
    let cons hd tl = StackNode(hd, tl)
    
    let empty = EmptyStack

假设我们想要为我们的栈添加一些方法，例如，一种更新特定索引处项的方法。由于我们的节点是不可变的，我们无法就地更新列表；我们需要复制所有节点，直到我们要更新的节点。

Setting item at index 2 to the value 9.

         0      1      2      3      4
          ___    ___    ___    ___    ___ 
let x =  |_1_|->|_2_|->|_3_|->|_4_|->|_5_|->Empty
                              ^
                             /
          ___    ___    ___ /
let y =  |_1_|->|_2_|->|_9_|

因此，我们将复制所有节点，直到索引 2，然后重用剩余的节点。编写这样的函数非常容易

let rec update index value s =
    match index, s with
    | index, EmptyStack -> failwith "Index out of range"
    | 0, StackNode(hd, tl) -> StackNode(value, tl)
    | n, StackNode(hd, tl) -> StackNode(hd, update (index - 1) value tl)

将一个栈中的项追加到另一个栈的尾部使用类似的技术。由于我们无法就地修改栈，因此我们通过复制来自“前面”栈的所有节点并指向最后一个复制节点到我们的“后面”栈来追加两个栈，结果如下

Append x and y

          ___    ___    ___    ___    ___ 
let x =  |_1_|->|_2_|->|_3_|->|_4_|->|_5_|->Empty
                                             ___    ___    ___ 
let y =                                     |_6_|->|_7_|->|_8_|->Empty
                                            ^
                                           /
          ___    ___    ___    ___    ___ /
let z =  |_1_|->|_2_|->|_3_|->|_4_|->|_5_|

我们可以使用以下代码轻松实现此功能

let rec append x y =
    match x with
    | EmptyStack -> y
    | StackNode(hd, tl) -> StackNode(hd, append tl y)

栈非常易于使用和实现。复制节点以“修改”栈的原理对于所有持久数据结构来说都是一样的。

完整栈模块 

module Stack =
    type 'a stack =
        | EmptyStack
        | StackNode of 'a * 'a stack
        
    let hd = function
        | EmptyStack -> failwith "Empty stack"
        | StackNode(hd, tl) -> hd
        
    let tl = function
        | EmptyStack -> failwith "Emtpy stack"
        | StackNode(hd, tl) -> tl
        
    let cons hd tl = StackNode(hd, tl)
    
    let empty = EmptyStack
    
    let rec update index value s =
        match index, s with
        | index, EmptyStack -> failwith "Index out of range"
        | 0, StackNode(hd, tl) -> StackNode(value, tl)
        | n, StackNode(hd, tl) -> StackNode(hd, update (index - 1) value tl)
        
    let rec append x y =
        match x with
        | EmptyStack -> y
        | StackNode(hd, tl) -> StackNode(hd, append tl y)

    let rec map f = function
        | EmptyStack -> EmptyStack
        | StackNode(hd, tl) -> StackNode(f hd, map f tl)
        
    let rec rev s =
        let rec loop acc = function
            | EmptyStack -> acc
            | StackNode(hd, tl) -> loop (StackNode(hd, acc)) tl
        loop EmptyStack s

    let rec contains x = function
        | EmptyStack -> false
        | StackNode(hd, tl) -> hd = x || contains x tl
        
    let rec fold f seed = function
        | EmptyStack -> seed
        | StackNode(hd, tl) -> fold f (f seed hd) tl

队列

[编辑 | 编辑源代码]

朴素队列

[编辑 | 编辑源代码]

队列不像栈那么简单。朴素队列可以使用栈来实现，前提是

  • 项始终追加到列表的末尾，并从栈的头部出队。
  • - 或者 - 项预先追加到栈的前面，并通过反转栈并获取其头部来出队。
(* AwesomeCollections.fsi *)

type 'a stack =
  | EmptyStack
  | StackNode of 'a * 'a stack
  
module Stack = begin
  val hd : 'a stack -> 'a
  val tl : 'a stack -> 'a stack
  val cons : 'a -> 'a stack -> 'a stack
  val empty : 'a stack
  val rev : 'a stack -> 'a stack
end

[<Class>]
type 'a Queue =
    member hd : 'a
    member tl : 'a Queue
    member enqueue : 'a -> 'a Queue
    static member empty : 'a Queue

(* AwesomeCollections.fs *)

type 'a stack =
    | EmptyStack
    | StackNode of 'a * 'a stack
        
module Stack =        
    let hd = function
        | EmptyStack -> failwith "Empty stack"
        | StackNode(hd, tl) -> hd
        
    let tl = function
        | EmptyStack -> failwith "Emtpy stack"
        | StackNode(hd, tl) -> tl
        
    let cons hd tl = StackNode(hd, tl)
    
    let empty = EmptyStack
        
    let rec rev s =
        let rec loop acc = function
            | EmptyStack -> acc
            | StackNode(hd, tl) -> loop (StackNode(hd, acc)) tl
        loop EmptyStack s
    
type Queue<'a>(item : stack<'a>) =
    member this.hd
        with get() = Stack.hd (Stack.rev item)
        
    member this.tl
        with get() = Queue(item |> Stack.rev |> Stack.tl |> Stack.rev)
        
    member this.enqueue(x) = Queue(StackNode(x, item))
    
    override this.ToString() = sprintf "%A" item
    
    static member empty = Queue<'a>(Stack.empty)

我们使用一个接口文件来隐藏 Queue 类的构造函数。虽然这在技术上满足了队列的功能，但每次出队都是一个 O(n) 操作，其中 n 是队列中的项目数量。有许多相同方法的变体，但在实践中，这些方法通常并不实用。我们当然可以改进不可变队列的实现。

两个栈实现的队列

[编辑 | 编辑源代码]

上面的实现效率不高，因为它需要多次反转我们的底层数据表示。为什么不保留这些反转的栈以备将来使用？与其使用一个栈，我们可以使用两个栈：一个前面栈 f 和一个后面栈 r。

栈 f 按正确顺序保存项目，而栈 r 按反向顺序保存项目；这允许 f 中的第一个元素成为队列的头部，r 中的第一个元素成为队列的最后一个项目。因此，数字 1 .. 6 的队列可以用 f = [1;2;3] 和 r = [6;5;4] 表示。

要入队新项目，将其预先追加到 r 的前面；要出队项目，将其从 f 中弹出。入队和出队都是 O(1) 操作。当然，在某个时刻，f 会为空，并且没有更多项目可出队；在这种情况下，只需将所有项目从 r 移动到 f 并反转列表。虽然队列确实具有 O(n) 的最坏情况行为，但它具有可接受的 O(1) 的均摊（平均情况）边界。

此实现的代码很简单

type Queue<'a>(f : stack<'a>, r : stack<'a>) =
    let check = function
        | EmptyStack, r -> Queue(Stack.rev r, EmptyStack)
        | f, r -> Queue(f, r)

    member this.hd =
        match f with
        | EmptyStack -> failwith "empty"
        | StackNode(hd, tl) -> hd
        
    member this.tl =
        match f, r with
        | EmptyStack, _ -> failwith "empty"
        | StackNode(x, f), r -> check(f, r)
        
    member this.enqueue(x) = check(f, StackNode(x, r))
    
    static member empty = Queue<'a>(Stack.empty, Stack.empty)

这是一个简单、常用且有用的不可变队列实现。魔法在于 check 函数，该函数始终维护 f 在有项目可用时始终包含项目。

注意： 队列的周期性 O(n) 最坏情况行为会使其响应时间不可预测，特别是在高度依赖持久性的应用程序中，因为每次访问队列时都有可能遇到病态情况。但是，这种特定队列实现对于大多数不需要持久性或一致响应时间的应用程序来说是完全足够的。

如上所示，我们通常希望将底层数据结构包装在类中，原因有两个

  1. 简化数据结构的接口。例如，客户端既不知道也不关心我们的队列使用两个栈；他们只知道队列中的项目遵循先进先出的原则。
  2. 防止客户端将底层数据放入数据结构中无效状态。

除了栈之外，几乎所有数据结构都足够复杂，需要包装类以隐藏复杂细节，不让客户端看到。

二叉搜索树

[编辑 | 编辑源代码]

二叉搜索树类似于栈，但每个节点指向另外两个节点，称为左子节点和右子节点

type 'a tree =
    | EmptyTree
    | TreeNode of 'a * 'a tree * 'a tree

此外，树中的节点以特定方式排序：树中的每个项目都大于其左子节点中的所有项目，小于其右子节点中的所有项目。

由于我们的树是不可变的，因此我们通过返回一个带有插入节点的新树来“插入”树。这个过程比听起来更有效：我们在向下遍历树时复制节点，因此我们只复制插入节点路径上的节点。编写二叉搜索树相对简单

(* AwesomeCollections.fsi *)

[<Class>]
type 'a BinaryTree =
    member hd : 'a
    member exists : 'a -> bool
    member insert : 'a -> 'a BinaryTree

(* AwesomeCollections.fs *)

type 'a tree =
    | EmptyTree
    | TreeNode of 'a * 'a tree * 'a tree
    
module Tree =
    let hd = function
        | EmptyTree -> failwith "empty"
        | TreeNode(hd, l, r) -> hd
        
    let rec exists item = function
        | EmptyTree -> false
        | TreeNode(hd, l, r) ->
            if hd = item then true
            elif item < hd then exists item l
            else exists item r
            
    let rec insert item = function
        | EmptyTree -> TreeNode(item, EmptyTree, EmptyTree)
        | TreeNode(hd, l, r) as node ->
            if hd = item then node
            elif item < hd then TreeNode(hd, insert item l, r)
            else TreeNode(hd, l, insert item r)
    
type 'a BinaryTree(inner : 'a tree) =
    member this.hd = Tree.hd inner
        
    member this.exists item = Tree.exists item inner
            
    member this.insert item = BinaryTree(Tree.insert item inner)
    
    member this.empty = BinaryTree<'a>(EmptyTree)

我们使用一个接口和一个包装类来隐藏树的实现细节，否则用户可以构建一个违反二叉树中使用的特定排序规则的树。

此实现很简单，允许我们在 O(log n) 最佳情况时间内添加和查找树中的任何项目。但是，它有一个病态情况：如果我们按排序顺序或几乎按排序顺序添加项目，那么树可能会变得非常不平衡。例如，以下代码

[1 .. 7] |> Seq.fold (fun (t : BinaryTree<_>) x -> t.insert(x)) BinaryTree.empty

生成这棵树

    1
   / \
  E   2
     / \
    E   3
       / \
      E   4
         / \
        E   5
           / \
          E   6
             / \
            E   7
               / \
              E   E

这样的树与我们上面提到的低效队列实现并没有太大区别！树在高度最小且尽可能饱满时效率最高。理想情况下，我们希望将上面的树表示如下

         
        _ 4 _
       /     \
      2       6
     / \     / \
    1   3   5   7
   / \ / \ / \ / \
   E E E E E E E E

树的最小高度为 ceiling(log n + 1)，其中 n 是列表中的项目数量。当我们将项目插入树时，我们希望树能够自行平衡以保持最小高度。有许多自我平衡树实现，其中许多实现很容易作为不可变数据结构来实现。

红黑树

[编辑 | 编辑源代码]

红黑树是自我平衡树，它们为树中的每个节点附加一个“颜色”属性。除了定义二叉搜索树的规则之外，红黑树还必须维护以下规则集

  1. 节点要么是红色，要么是黑色。
  2. 根节点始终是黑色。
  3. 没有红色节点有红色子节点。
  4. 从给定节点到其任何后代叶子的每条简单路径都包含相同数量的黑色节点。
红黑树的一个例子

我们可以通过以下方式为二叉树添加颜色字段

type color = R | B    
type 'a tree =
    | E
    | T of color * 'a * 'a tree * 'a tree

当我们在树中插入节点时，我们需要重新平衡树以恢复规则。特别地，我们需要删除具有红色子节点的节点。一个红色节点可能具有红色子节点的四种情况。它们在下面的图表中由顶部、右侧、底部和左侧树表示。中间树是平衡版本。

                        B(z)
                        /  \
                      R(x)  d
                      /  \
                     a   R(y)
                         /  \
                        b    c
  
                         ||
                         \/

      B(z)              B(y)                 B(x)
      /  \              /  \                 /  \
    R(y)  d    =>     R(x) R(z)    <=       a   R(y)
    /  \              / \  / \                  /  \
  R(x)  c             a b  c d                 b   R(z)
  /  \                                             /  \
 a    b                                           c    d

                         /\
                         ||

                       B(x)
                       /  \
                      a   R(z)
                          /  \
                        R(y)  d
                        /  \
                       b    c

我们可以修改我们的二叉树类，如下所示

(* AwesomeCollections.fsi *)

[<Class>]
type 'a BinaryTree =
    member hd : 'a
    member left : 'a BinaryTree
    member right : 'a BinaryTree
    member exists : 'a -> bool
    member insert : 'a -> 'a BinaryTree
    member print : unit -> unit
    static member empty : 'a BinaryTree

(* AwesomeCollections.fs *)

type color = R | B    
type 'a tree =
    | E
    | T of color * 'a tree * 'a * 'a tree
    
module Tree =
    let hd = function
        | E -> failwith "empty"
        | T(c, l, x, r) -> x
        
    let left = function
        | E -> failwith "empty"
        | T(c, l, x, r) -> l
    
    let right = function
        | E -> failwith "empty"
        | T(c, l, x, r) -> r
        
    let rec exists item = function
        | E -> false
        | T(c, l, x, r) ->
            if item = x then true
            elif item < x then exists item l
            else exists item r
            
    let balance = function                              (* Red nodes in relation to black root *)
        | B, T(R, T(R, a, x, b), y, c), z, d            (* Left, left *)
        | B, T(R, a, x, T(R, b, y, c)), z, d            (* Left, right *)
        | B, a, x, T(R, T(R, b, y, c), z, d)            (* Right, left *)
        | B, a, x, T(R, b, y, T(R, c, z, d))            (* Right, right *)
            -> T(R, T(B, a, x, b), y, T(B, c, z, d))
        | c, l, x, r -> T(c, l, x, r)
    
    let insert item tree =
        let rec ins = function
            | E -> T(R, E, item, E)
            | T(c, a, y, b) as node ->
                if item = y then node
                elif item < y then balance(c, ins a, y, b)
                else balance(c, a, y, ins b)

        (* Forcing root node to be black *)                
        match ins tree with
            | E -> failwith "Should never return empty from an insert"
            | T(_, l, x, r) -> T(B, l, x, r)
            
    let rec print (spaces : int) = function
        | E -> ()
        | T(c, l, x, r) ->
            print (spaces + 4) r
            printfn "%s %A%A" (new System.String(' ', spaces)) c x
            print (spaces + 4) l
    
type 'a BinaryTree(inner : 'a tree) =
    member this.hd = Tree.hd inner
    member this.left = BinaryTree(Tree.left inner)
    member this.right = BinaryTree(Tree.right inner)
    member this.exists item = Tree.exists item inner
    member this.insert item = BinaryTree(Tree.insert item inner)
    member this.print() = Tree.print 0 inner
    static member empty = BinaryTree<'a>(E)

使这棵树起作用的所有“魔力”都在 balance 函数中。我们没有对树进行任何非常复杂的转换，但它最终变得相对平衡（实际上，这棵树的最大深度为 2 * ceil(log n + 1)）。

AVL 树

[编辑 | 编辑源代码]

AVL 树以其两位发明者 G.M. Adelson-Velskii 和 E.M. Landis 的名字命名。这些树是自平衡的，因为任何节点的两个子树的高度之差仅为 0 或 1；因此，这些树被称为高度平衡。

树中的空节点的高度为 0；非空节点的高度 >= 1。我们可以在树定义中存储每个节点的高度

type 'a tree =
    | Node of int * 'a tree * 'a * 'a tree  (* height, left child, value, right child *)
    | Nil

任何节点的高度等于 max(左高度，右高度) + 1。为了方便起见，我们将使用以下构造函数来创建树节点并初始化其高度

let height = function
    | Node(h, _, _, _) -> h
    | Nil -> 0
    
let make l x r =
    let h = 1 + max (height l) (height r)
    Node(h, l, x ,r)

在 AVL 树中插入节点与在不平衡二叉树中插入节点非常相似，唯一的例外是：在插入节点后，我们使用一系列树旋转来重新平衡树。每个节点都有一个隐含的属性，即其平衡因子，它指的是左子节点的高度减去右子节点的高度；正平衡因子表示树向左倾斜，负平衡因子表示树向右倾斜，否则树是平衡的。

我们只需要在节点的平衡因子为 +/-2 时重新平衡树。有四种情况会导致我们的树变得不平衡

左-左情况：根平衡因子 = +2，左子节点的平衡因子 = +1。通过将根节点向右旋转来平衡

         5                            3
       /   \    Root                /   \
      3     D   Right rotation     2     5
    /  \            ----->        / \   / \
   2    C                        A   B C   D
  / \
 A   B

左-右情况：根平衡因子 = +2，右子节点的平衡因子 = -1。通过将左子节点向左旋转，然后将根节点向右旋转来平衡（此操作称为双重右旋转）

       5                              5                                 4
     /   \      Left child          /   \        Root                 /   \
   3      D     Left rotation      4     D       Right rotation      3     5
  / \                ----->       / \               ----->          / \   / \
 A   4                           3   C                             A   B C   D
    / \                         / \
   B   C                       A   B

右-右情况：根平衡因子 = -2，右子节点的平衡因子 = -1。通过将根节点向左旋转来平衡

    3                                 5
  /   \         Root                /   \
 A     5        Left rotation      3     7
      / \           ----->        / \   / \
     B   7                       A   B C   D
        / \
       C   D

右-左情况：根平衡因子 = -2，右子节点的平衡因子 = +1。通过将右子节点向右旋转，然后将根节点向左旋转来平衡（此操作称为双重左旋转）

     3                               3                                 4
   /   \        Right child        /   \        Root                 /   \
  A      5      Right rotation    A     4       Left rotation       3     5
        / \         ----->             / \         ----->          / \   / \
       4   D                          B   5                       A   B C   D
      / \                                / \
     B   C                              C   D

考虑到这一点，我们可以很容易地组合我们的 AVL 树的其余部分

(* AwesomeCollections.fsi *)
[<Class>]
type 'a AvlTree =
    member Height : int
    member Left : 'a AvlTree
    member Right : 'a AvlTree
    member Value : 'a
    member Insert : 'a -> 'a AvlTree
    member Contains : 'a -> bool

module AvlTree =
    [<GeneralizableValue>]
    val empty<'a> : AvlTree<'a>

(* AwesomeCollections.fs *)

type 'a tree =
    | Node of int * 'a tree * 'a * 'a tree
    | Nil
    
(*
    Notation:
        h = height
        x = value
        l = left child
        r = right child
        
        lh = left child's height
        lx = left child's value
        ll = left child's left child
        lr = left child's right child
        
        rh = right child's height
        rx = right child's value
        rl = right child's left child
        rr = right child's right child
*)
    
let height = function
    | Node(h, _, _, _) -> h
    | Nil -> 0
    
let make l x r =
    let h = 1 + max (height l) (height r)
    Node(h, l, x ,r)

let rotRight = function
    | Node(_, Node(_, ll, lx, lr), x, r) ->
        let r' = make lr x r
        make ll lx r'
    | node -> node
    
let rotLeft = function
    | Node(_, l, x, Node(_, rl, rx, rr)) ->
        let l' = make l x rl
        make l' rx rr
    | node -> node
    
let doubleRotLeft = function
    | Node(h, l, x, r) ->
        let r' = rotRight r
        let node' = make l x r'
        rotLeft node'
    | node -> node
    
let doubleRotRight = function
    | Node(h, l, x, r) ->
        let l' = rotLeft l
        let node' = make l' x r
        rotRight node'
    | node -> node
    
let balanceFactor = function
    | Nil -> 0
    | Node(_, l, _, r) -> (height l) - (height r)
    
let balance = function
    (* left unbalanced *)
    | Node(h, l, x, r) as node when balanceFactor node >= 2 ->
        if balanceFactor l >= 1 then rotRight node      (* left left case *)
        else doubleRotRight node                        (* left right case *)
    (* right unbalanced *)
    | Node(h, l, x, r) as node when balanceFactor node <= -2 ->
        if balanceFactor r <= -1 then rotLeft node      (* right right case *)
        else doubleRotLeft node                         (* right left case *)
    | node -> node
    
let rec insert v = function
    | Nil -> Node(1, Nil, v, Nil)
    | Node(_, l, x, r) as node ->
        if v = x then node
        else
            let l', r' = if v < x then insert v l, r else l, insert v r
            let node' = make l' x r'
            balance <| node'
            
let rec contains v = function
    | Nil -> false
    | Node(_, l, x, r) ->
        if v = x then true
        else
            if v < x then contains v l
            else contains v r

type 'a AvlTree(tree : 'a tree) =
    member this.Height = height tree
    
    member this.Left =
        match tree with
        | Node(_, l, _, _) -> new AvlTree<'a>(l)
        | Nil -> failwith "Empty tree"
    
    member this.Right =
        match tree with
        | Node(_, _, _, r) -> new AvlTree<'a>(r)
        | Nil -> failwith "Empty tree"
        
    member this.Value =
        match tree with
        | Node(_, _, x, _) -> x
        | Nil -> failwith "Empty tree"
        
    member this.Insert(x) = new AvlTree<'a>(insert x tree)
    
    member this.Contains(v) = contains v tree
    
module AvlTree =
    [<GeneralizableValue>]
    let empty<'a> : AvlTree<'a> = new AvlTree<'a>(Nil)
注意：[<GeneralizableValue>] 属性指示 F# 该构造可以通过类型推断产生泛型代码。如果没有该属性，F# 将推断 AvlTree.empty 的类型为未定义类型 AvlTree<'_a>，导致在编译时出现“值限制”错误。
优化技巧：这棵树支持在 log(n) 时间内进行插入和查找，其中 n 是树中节点的数量。这已经相当不错了，但我们可以通过消除不必要的比较来使其更快。请注意，当我们将节点插入到树的左侧时，我们只能向左子节点添加权重；但是，balance 函数在每次插入时都会检查树的两侧。通过将 balance 重写为 balance_left 和 balance_right 函数来分别处理，我们可以分别处理左子节点和右子节点的插入。类似的优化也可以在红黑树实现中进行。

AVL 树的高度限制为 1.44 * log(n)，而红黑树的高度限制为 2 * log(n)。AVL 树更小的高度和更严格的平衡导致插入/删除速度更慢，但检索速度比红黑树更快。在实践中，差异几乎不会显着：在 10,000,000 个节点的 AVL 树上进行查找最多需要 34 次比较，而在红黑树上进行查找最多需要 47 次比较。

堆

[编辑 | 编辑源代码]

二叉搜索树可以有效地查找集合中的任意元素，但有时也可以有效地访问集合中的最小元素。堆是一种特殊的数据结构，它满足堆属性：每个节点的值都大于其任何子节点的值。此外，我们可以使用左式属性来保持树的近似平衡，这意味着任何左子堆的高度至少与它的右兄弟一样大。我们可以在每个堆节点中保存每个树的高度。

最后，由于堆可以实现为最小堆或最大堆，其中根元素要么是集合中最大的元素，要么是最小的元素，因此我们通过将排序函数传递到堆的构造函数中来支持两种类型的堆，如下所示

type 'a heap =
    | EmptyHeap
    | HeapNode of int * 'a * 'a heap * 'a heap
    
type 'a BinaryHeap(comparer : 'a -> 'a -> int, inner : 'a heap) =
    static member make(comparer) = BinaryHeap<_>(comparer, EmptyHeap)
注意：通过将 comparer 函数传递到 BinaryHeap 构造函数中获得的功能近似于 OCaml 函数，但它并不像那么优雅。

左式属性的一个有趣的结果是，堆中任何路径上的元素都按排序顺序存储。这意味着我们可以通过合并它们的右脊柱并根据需要交换子节点来恢复左式属性来合并任何两个堆。由于每个右脊柱包含的节点数量至少与左脊柱一样多，因此每个右脊柱的高度与堆中元素数量的对数成正比，因此合并两个堆可以在 O(log n) 时间内完成。我们可以如下实现堆的所有属性

(* AwesomeCollections.fsi *)

[<Class>]
type 'a BinaryHeap =
    member hd : 'a
    member tl : 'a BinaryHeap
    member insert : 'a -> 'a BinaryHeap
    member merge : 'a BinaryHeap -> 'a BinaryHeap
    interface System.Collections.IEnumerable
    interface System.Collections.Generic.IEnumerable<'a>
    static member make : ('b -> 'b -> int) -> 'b BinaryHeap

(* AwesomeCollections.fs *)

type 'a heap =
    | EmptyHeap
    | HeapNode of int * 'a * 'a heap * 'a heap
 
module Heap =
    let height = function
        | EmptyHeap -> 0
        | HeapNode(h, _, _, _) -> h
 
    (* Helper function to restore the leftist property *)        
    let makeT (x, a, b) =
        if height a >= height b then HeapNode(height b + 1, x, a, b)
        else HeapNode(height a + 1, x, b, a)
 
    let rec merge comparer = function
        | x, EmptyHeap -> x
        | EmptyHeap, x -> x
        | (HeapNode(_, x, l1, r1) as h1), (HeapNode(_, y, l2, r2) as h2) ->
            if comparer x y <= 0 then makeT(x, l1, merge comparer (r1, h2))
            else makeT (y, l2, merge comparer (h1, r2))
 
    let hd = function
        | EmptyHeap -> failwith "empty"
        | HeapNode(h, x, l, r) -> x
 
    let tl comparer = function
        | EmptyHeap -> failwith "empty"
        | HeapNode(h, x, l, r) -> merge comparer (l, r)
        
    let rec to_seq comparer = function
        | EmptyHeap -> Seq.empty
        | HeapNode(h, x, l, r) as node -> seq { yield x; yield! to_seq comparer (tl comparer node) }
 
type 'a BinaryHeap(comparer : 'a -> 'a -> int, inner : 'a heap) =
    (* private *)
    member this.inner = inner
 
    (* public *)
    member this.hd = Heap.hd inner
    member this.tl = BinaryHeap(comparer, Heap.tl comparer inner)
    member this.merge (other : BinaryHeap<_>) = BinaryHeap(comparer, Heap.merge comparer (inner, other.inner))
    member this.insert x = BinaryHeap(comparer, Heap.merge comparer (inner,(HeapNode(1, x, EmptyHeap, EmptyHeap))))
    
    interface System.Collections.Generic.IEnumerable<'a> with
        member this.GetEnumerator() = (Heap.to_seq comparer inner).GetEnumerator()
            
    interface System.Collections.IEnumerable with
        member this.GetEnumerator() = (Heap.to_seq comparer inner :> System.Collections.IEnumerable).GetEnumerator()
 
    static member make(comparer) = BinaryHeap<_>(comparer, EmptyHeap)

此堆实现了 IEnumerable<'a> 接口，允许我们像 seq 一样迭代它。除了上面显示的左式堆之外，还可以非常轻松地在 F# 中实现不可变的 splay 堆、二项式堆、斐波那契堆、配对堆和许多其他树状数据结构的版本。

惰性数据结构

[编辑 | 编辑源代码]

值得注意的是，上面的一些纯函数数据结构不如它们的命令式实现效率高。例如，将两个不可变堆栈 x 和 y 连接在一起需要 O(n) 时间，其中 n 是堆栈 x 中元素的数量。但是，我们可以利用 惰性 以使纯函数数据结构与它们的命令式对应物一样高效。

例如，可以很容易地创建一个类似堆栈的数据结构，它将所有计算延迟到真正需要的时候

type 'a lazyStack =
    | Node of Lazy<'a * 'a lazyStack>
    | EmptyStack
 
module LazyStack =
    let (|Cons|Nil|) = function
        | Node(item) ->
            let hd, tl = item.Force()
            Cons(hd, tl)
        | EmptyStack -> Nil
 
    let hd = function
        | Cons(hd, tl) -> hd
        | Nil -> failwith "empty"
 
    let tl = function
        | Cons(hd, tl) -> tl
        | Nil -> failwith "empty"
 
    let cons(hd, tl) = Node(lazy(hd, tl))
    
    let empty = EmptyStack
 
    let rec append x y =
        match x with
        | Cons(hd, tl) -> Node(lazy(printfn "appending... got %A" hd; hd, append tl y))
        | Nil -> y
 
    let rec iter f = function
        | Cons(hd, tl) -> f(hd); iter f tl
        | Nil -> ()

在上面的示例中，append 操作返回一个节点，并将其余的计算延迟，因此连接两个列表将发生在常数时间内。上面添加了一个 printfn 语句来演示我们实际上直到第一次访问连接的值时才计算它们

> open LazyStack;;
> let x = cons(1, cons(2, cons(3, cons(4, EmptyStack))));;

val x : int lazyStack = Node <unevaluated>

> let y = cons(5, cons(6, cons(7, EmptyStack)));;

val y : int lazyStack = Node <unevaluated>

> let z = append x y;;

val z : int lazyStack = Node <unevaluated>

> hd z;;
appending... got 1
val it : int = 1

> hd (tl (tl z) );;
appending... got 2
appending... got 3
val it : int = 3

> iter (fun x -> printfn "%i" x) z;;
1
2
3
appending... got 4
4
5
6
7
val it : unit = ()

有趣的是，append 方法显然在 O(1) 时间内运行，因为实际的连接操作被延迟到用户获取列表头部时。同时，获取列表头部可能会产生副作用，即最多触发一次对连接方法的调用，而不会导致对数据结构其余部分进行整体重建，因此获取头部本身也是一个 O(1) 操作。此堆栈实现支持常数时间内进行追加和连接，以及线性时间内进行查找。

类似地，惰性队列的实现也存在，它们支持所有操作的 O(1) 最坏情况行为。

其他资源

[编辑 | 编辑源代码]
上一节：主动模式 索引 下一节：反射
取自"https://wikibooks.cn/w/index.php?title=F_Sharp_Programming/Advanced_Data_Structures&oldid=4207759"
华夏公益教科书