F#代码优化：左倾红黑树

Question

F#代码优化：左倾红黑树

optimizationf#tree

3

我一直在将C#实现的LLRBT移植到F#，现在已经成功运行。我的问题是如何进行优化？

以下是一些想法：

使用区分联合类型（Discriminated Union）来移除对null的使用。
移除getter和setter
- 你不能同时拥有一个空属性和一个结构体。

完整源代码可以在这里找到。C#代码取自Delay的博客。

当前性能
F# 经过时间 = 00:00:01.1379927 树高：26，节点数：487837
C# 经过时间 = 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

- gradbot

1

它看起来非常命令式。这是将C#代码直接翻译成命令式F#吗？一些递归的、函数式风格的F#会很酷，而且肯定比命令式版本更短。 - Robert Harvey

我对LLRBT算法的理解还不够，无法尝试编写一个不可变的函数式版本。 - gradbot

如果它能正常运行并且是直接翻译的，我预计C#版本会更快一些。 - Robert Harvey

@gradbot：我认为使用有点新颖的语法编写C#没有太大意义。由于LLRBT是2-3-4树的变体，您是否已经编写了F#中的2-3-4树的不可变版本？红黑树的不可变版本呢？如果没有，那么您正在过早地超前自己。从简单的数据结构，如AVL树开始，然后逐步升级到更复杂的数据结构。 - Juliet

4个回答

3

我写了一个不可变版本，它的性能比上面的可变版本更好。目前我只实现了插入操作，我还在努力解决性能问题。

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 -> ()
    }

- gradbot

不错！我会在你的iter函数中使用Seq.unfold来创建序列。 - J D

此外，您在模式匹配的右侧执行了许多重复操作。您可以使用“or”模式将它们合并为单个匹配案例。 - J D

2

如果你愿意考虑不可变实现，你可能需要查看克里斯·奥卡萨基在函数式环境中关于红黑树的论文这里。

- kvb

@Jon，我添加了一个新的不可变版本作为答案，如果你感兴趣的话。但是不能删除。 :) - gradbot

1

我的问题是如何对此进行优化？

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

- J D

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Brian · Accepted Answer

我很惊讶这两种实现之间有这么大的性能差异，因为看起来这只是一个简单的音译。我猜想两者都是在“发布”模式下编译的？您是分别运行了两个版本（冷启动），还是如果两个版本在同一个程序中，则反转了两个版本的顺序（例如，温暖的缓存）？是否进行了任何分析（有一个好的分析工具）？比较了内存消耗（即使fsi.exe也可以帮助解决这个问题）？

（对于这个可变数据结构实现，我没有看到任何明显的改进空间。）