左倾红黑树的 F# 代码优化答案

【问题标题】：F# Code Optimization for Left Leaning Red Black Tree左倾红黑树的 F# 代码优化
【发布时间】：2009-11-12 03:48:09
【问题描述】：

我一直致力于将 LLRBT 的 C# 实现移植到 F#，现在它可以正常运行。我的问题是我将如何优化这个？

我的一些想法

对节点使用可区分联合来删除 null 的使用
删除 getter 和 setter
- 你不能同时拥有一个空属性和一个结构

可以在here找到完整的源代码。 C# 代码取自Delay's Blog。

目前的表现
F# Elapsed = 00:00:01.1379927 高度：26，计数：487837
C# Elapsed = 00:00:00.7975849 高度：26，计数：487837

module Erik

let Black = true
let Red = false

[<AllowNullLiteralAttribute>]
type Node(_key, _value, _left:Node, _right:Node, _color:bool) =
    let mutable key = _key
    let mutable value = _value
    let mutable left = _left
    let mutable right = _right
    let mutable color = _color
    let mutable siblings = 0

    member this.Key with get() = key and set(x) = key <- x
    member this.Value with get() = value and set(x) = value <- x
    member this.Left with get() = left and set(x) = left <- x
    member this.Right with get() = right and set(x) = right <- x
    member this.Color with get() = color and set(x) = color <- x
    member this.Siblings with get() = siblings and set(x) = siblings <- x

    static member inline IsRed(node : Node) =
        if node = null then
            // "Virtual" leaf nodes are always black
            false
        else
            node.Color = Red

    static member inline Flip(node : Node) =
        node.Color <- not node.Color
        node.Right.Color <- not node.Right.Color
        node.Left.Color <- not node.Left.Color

    static member inline RotateLeft(node : Node) =
        let x = node.Right
        node.Right <- x.Left
        x.Left <- node
        x.Color <- node.Color
        node.Color <- Red
        x

    static member inline RotateRight(node : Node) =
        let x = node.Left
        node.Left <- x.Right
        x.Right <- node
        x.Color <- node.Color
        node.Color <- Red
        x

    static member inline MoveRedLeft(_node : Node) =
        let mutable node = _node
        Node.Flip(node)

        if Node.IsRed(node.Right.Left) then
            node.Right <- Node.RotateRight(node.Right)
            node <- Node.RotateLeft(node)
            Node.Flip(node)

            if Node.IsRed(node.Right.Right) then
                node.Right <- Node.RotateLeft(node.Right)
        node

    static member inline MoveRedRight(_node : Node) =
        let mutable node = _node
        Node.Flip(node)

        if Node.IsRed(node.Left.Left) then
            node <- Node.RotateRight(node)
            Node.Flip(node)
        node

    static member DeleteMinimum(_node : Node) =
        let mutable node = _node

        if node.Left = null then
            null
        else
            if not(Node.IsRed(node.Left)) && not(Node.IsRed(node.Left.Left)) then
                node <- Node.MoveRedLeft(node)

            node.Left <- Node.DeleteMinimum(node)
            Node.FixUp(node)

    static member FixUp(_node : Node) =
        let mutable node = _node

        if Node.IsRed(node.Right) then
            node <- Node.RotateLeft(node)

        if Node.IsRed(node.Left) && Node.IsRed(node.Left.Left) then
            node <- Node.RotateRight(node)

        if Node.IsRed(node.Left) && Node.IsRed(node.Right) then
            Node.Flip(node)

        if node.Left <> null && Node.IsRed(node.Left.Right) && not(Node.IsRed(node.Left.Left)) then
            node.Left <- Node.RotateLeft(node.Left)
            if Node.IsRed(node.Left) then
                node <- Node.RotateRight(node)
        node

type LeftLeaningRedBlackTree(?isMultiDictionary) =
    let mutable root = null
    let mutable count = 0        

    member this.IsMultiDictionary =
       Option.isSome isMultiDictionary

    member this.KeyAndValueComparison(leftKey, leftValue, rightKey, rightValue) =
        let comparison = leftKey - rightKey
        if comparison = 0 && this.IsMultiDictionary then
            leftValue - rightValue
        else
            comparison

    member this.Add(key, value) =
        root <- this.add(root, key, value)

    member private this.add(_node : Node, key, value) =
        let mutable node = _node

        if node = null then
            count <- count + 1
            new Node(key, value, null, null, Red)
        else
            if Node.IsRed(node.Left) && Node.IsRed(node.Right) then
                Node.Flip(node)

            let comparison = this.KeyAndValueComparison(key, value, node.Key, node.Value)

            if comparison < 0 then
                node.Left <- this.add(node.Left, key, value)
            elif comparison > 0 then
                node.Right <- this.add(node.Right, key, value)
            else
                if this.IsMultiDictionary then
                    node.Siblings <- node.Siblings + 1
                    count <- count + 1
                else
                   node.Value <- value

            if Node.IsRed(node.Right) then
                node <- Node.RotateLeft(node)

            if Node.IsRed(node.Left) && Node.IsRed(node.Left.Left) then
                node <- Node.RotateRight(node)

            node

【问题讨论】：

这看起来很有必要。是否将 C# 代码直接翻译为命令式 F#？一些递归的函数式 F# 会非常酷，而且肯定会比命令式版本更短。
直接翻译。我对 LLRBT 算法的了解还不够，无法尝试不可变的功能版本。
如果它有效，而且是直接翻译，我希望 C# 版本会快一点。
@gradbot：我真的不认为用更时髦的语法编写 C# 有什么意义。由于 LLRBT 是 2-3-4 树的变体，您是否在 F# 中编写了 2-3-4 树的不可变版本？不可变的 RB 树怎么样？如果没有，那你就太超前了。从简单的数据结构（如 AVL 树）开始，然后逐步研究更复杂的数据结构。

标签： optimization f# tree

【解决方案1】：

我很惊讶会有这样的性能差异，因为这看起来像是一个简单的音译。我认为两者都是在“发布”模式下编译的？您是否分别运行了两个版本（冷启动），或者如果两个版本都在同一个程序中，则颠倒两者的顺序（例如热缓存）？做过任何分析（有一个好的分析器）？比较内存消耗（甚至 fsi.exe 也可以帮助）？

（我认为这种可变数据结构的实现没有任何明显的改进。）

【讨论】：

【解决方案2】：

我写了一个不可变版本，它的性能比上面的可变版本好。到目前为止，我只实现了插入。我仍在试图找出性能问题是什么。

type ILLRBT =
    | Red   of ILLRBT * int * ILLRBT
    | Black of ILLRBT * int * ILLRBT
    | Nil

let flip node = 
    let inline flip node =
        match node with
        |   Red(l, v, r) -> Black(l, v, r)
        | Black(l, v, r) ->   Red(l, v, r)
        | Nil -> Nil
    match node with
    |   Red(l, v, r) -> Black(flip l, v, flip r)
    | Black(l, v, r) ->   Red(flip l, v, flip r)
    | Nil -> Nil

let lRot = function
    |   Red(l, v,   Red(l', v', r'))
    |   Red(l, v, Black(l', v', r')) ->   Red(Red(l, v, l'), v', r')
    | Black(l, v,   Red(l', v', r'))
    | Black(l, v, Black(l', v', r')) -> Black(Red(l, v, l'), v', r')
    | _ -> Nil // could raise an error here

let rRot = function
    |   Red(  Red(l', v', r'), v, r)
    |   Red(Black(l', v', r'), v, r) ->   Red(l', v', Red(r', v, r))
    | Black(  Red(l', v', r'), v, r)
    | Black(Black(l', v', r'), v, r) -> Black(l', v', Red(r', v, r))
    | _ -> Nil // could raise an error here

let rec insert node value = 
    match node with
    | Nil -> Red(Nil, value, Nil)
    | n ->
        n
        |> function
            |   Red(Red(_), v, Red(_))
            | Black(Red(_), v, Red(_)) as node -> flip node
            | x -> x
        |> function
            |   Red(l, v, r) when value < v ->   Red(insert l value, v, r)
            | Black(l, v, r) when value < v -> Black(insert l value, v, r)
            |   Red(l, v, r) when value > v ->   Red(l, v, insert r value)
            | Black(l, v, r) when value > v -> Black(l, v, insert r value)
            | x -> x
        |> function
            |   Red(l, v, Red(_))
            | Black(l, v, Red(_)) as node -> lRot node
            | x -> x
        |> function
            |   Red(Red(Red(_),_,_), v, r)
            | Black(Red(Red(_),_,_), v, r) as node -> rRot node
            | x -> x

let rec iter node =
    seq {
        match node with
        |   Red(l, v, r)
        | Black(l, v, r) ->
            yield! iter l
            yield v
            yield! iter r
        | Nil -> ()
    }

【讨论】：

不错！我会使用Seq.unfold 在您的iter 函数中创建序列。
另外，在模式匹配的右侧有很多重复操作。您可以使用or-patterns 将它们合并为单个匹配案例。

【解决方案3】：

如果您愿意考虑不可变的实现，您可能需要查看 Chris Okasaki 的关于功能设置中的红黑树的论文 here。

【讨论】：

@Jon 我添加了一个新的不可变版本作为答案，以防您感兴趣。虽然没有删除。 :)

【解决方案4】：

我的问题是如何优化这个？

在可变情况下，您应该能够通过使用Node 结构的数组而不是堆分配每个单独的Node 来获得更好的性能。在不可变的情况下，您可以尝试将红色节点转换为结构。

【讨论】：