Оптимизация кода F# для наклонного влево красно-черного дерева

Я работал над переносом реализации LLRBT на C# на F#, и теперь она работает правильно. Мой вопрос в том, как я могу это оптимизировать?

Некоторые идеи у меня есть

  • Использование размеченного союза для узла для удаления использования нуля
  • Remove getters and setters
    • you cant have a null attribute and a struct at the same time

Полный исходный код можно найти здесь. Код 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

optimization f# tree
person gradbot    schedule 12.11.2009    source источник
comment
Выглядит очень обязательно. Является ли это прямым переводом кода C# на императивный F#? Некоторый рекурсивный F# в функциональном стиле был бы очень классным и наверняка был бы короче, чем императивная версия.   -  person Robert Harvey    schedule 12.11.2009
comment
Это прямой перевод. Я еще недостаточно понимаю алгоритм LLRBT, чтобы попытаться создать неизменяемую функциональную версию.   -  person gradbot    schedule 12.11.2009
comment
Если это работает, и это прямой перевод, я бы все равно ожидал, что версия C# будет немного быстрее.   -  person Robert Harvey    schedule 12.11.2009
comment
@gradbot: я действительно не думаю, что есть смысл писать на C# с немного более необычным синтаксисом. Поскольку LLRBT — это вариант деревьев 2-3-4, написали ли вы неизменяемую версию дерева 2-3-4 на F#? Как насчет неизменного дерева RB? Если нет, то вы слишком сильно забегаете вперед. Начните с более простых структур данных, таких как деревья AVL, а затем переходите к более сложным.   -  person Juliet    schedule 12.11.2009

Ответы (4)


arrow_upward
4
arrow_downward

Я удивлен, что такая разница в производительности, так как это выглядит как простая транслитерация. Я предполагаю, что оба скомпилированы в режиме «Выпуск»? Вы запускали обе по отдельности (холодный запуск) или, если обе версии в одной программе, меняли порядок двух (например, теплый кеш)? Делали ли вы профилирование (есть хороший профайлер)? Сравнивали потребление памяти (с этим может помочь даже fsi.exe)?

(Я не вижу каких-либо очевидных улучшений для реализации этой изменяемой структуры данных.)

person Brian    schedule 12.11.2009

arrow_upward
3
arrow_downward

Я написал неизменяемую версию, и она работает лучше, чем приведенная выше изменяемая версия. Пока я реализовал только вставку. Я все еще пытаюсь выяснить, в чем заключаются проблемы с производительностью.

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 -> ()
    }
person gradbot    schedule 05.07.2010
comment
Хороший! Я бы использовал Seq.unfold для создания последовательности в вашей функции iter. - person J D; 06.07.2010
comment
Кроме того, у вас есть много действий по дублированию справа от совпадений с шаблоном. Вы можете объединить их в отдельные случаи совпадения, используя or-шаблоны. - person J D; 16.04.2011

arrow_upward
2
arrow_downward

Если вы хотите рассмотреть неизменяемую реализацию, вы можете посмотреть статью Криса Окасаки о красно-черных деревьях в функциональной настройке здесь.

person kvb    schedule 12.11.2009
comment
@Jon Я добавил новую неизменяемую версию в качестве ответа, если вам интересно. Хотя без удаления. :) - person gradbot; 05.07.2010

arrow_upward
1
arrow_downward

Мой вопрос в том, как я могу это оптимизировать?

В изменяемом случае вы сможете получить значительно лучшую производительность, используя массив структур Node, а не куча, выделяющую каждую отдельную Node. В неизменном случае вы можете попробовать превратить красные узлы в структуры.

person J D    schedule 27.12.2013