¿Cómo convertirías este árbol mutable en uno inmutable?

Question

¿Cómo convertirías el nodo tipo en un árbol inmutable?

Esta clase implementa un árbol de rango que no permite rangos superpuestos o adyacentes y, en cambio, se une a ellos. Por ejemplo, si el nodo raíz es {min = 10; max = 20} Luego es el niño correcto y todos sus nietos deben tener un valor min y máximo mayor que 21. El valor máximo de un rango debe ser mayor o igual al min. Incluí una función de prueba para que pueda ejecutar esto como está y descartará cualquier caso que falle.

Recomiendo comenzar con el método Insertar para leer este código.

module StackOverflowQuestion

open System

type Range = 
    { min : int64; max : int64 }
with
    override this.ToString() =
        sprintf "(%d, %d)" this.min this.max

[<AllowNullLiteralAttribute>]
type Node(left:Node, right:Node, range:Range) =
    let mutable left = left
    let mutable right = right
    let mutable range = range


    // Symmetric to clean right
    let rec cleanLeft(node : Node) =
        if node.Left = null then
            ()
        elif range.max < node.Left.Range.min - 1L then 
            cleanLeft(node.Left)
        elif range.max <= node.Left.Range.max then
            range <- {min = range.min; max = node.Left.Range.max}
            node.Left <- node.Left.Right
        else
            node.Left <- node.Left.Right
            cleanLeft(node)

    // Clean right deals with merging when the node to merge with is not on the 
    // left outside of the tree.  It travels right inside the tree looking for an 
    // overlapping node.  If it finds one it merges the range and replaces the 
    // node with its left child thereby deleting it.  If it finds a subset node
    // it replaces it with its left child, checks it and continues looking right.
    let rec cleanRight(node : Node) =
        if node.Right = null then
            ()
        elif range.min > node.Right.Range.max + 1L then
            cleanRight(node.Right)
        elif range.min >= node.Right.Range.min then
            range <- {min = node.Right.Range.min; max = range.max}
            node.Right <- node.Right.Left
        else 
            node.Right <- node.Right.Left
            cleanRight(node)

    // Merger left is called whenever the min value of a node decreases.
    // It handles the case of left node overlap/subsets and merging/deleting them.
    // When no more overlaps are found on the left nodes it calls clean right.
    let rec mergeLeft(node : Node) =
        if node.Left = null then
            ()
        elif range.min <= node.Left.Range.min - 1L then 
            node.Left <- node.Left.Left
            mergeLeft(node)
        elif range.min <= node.Left.Range.max + 1L then
            range <- {min = node.Left.Range.min; max = range.max}
            node.Left <- node.Left.Left
        else 
            cleanRight(node.Left)

    // Symmetric to merge left
    let rec mergeRight(node : Node) =
        if node.Right = null then
            ()
        elif range.max >= node.Right.Range.max + 1L then
            node.Right <- node.Right.Right
            mergeRight(node)
        elif range.max >= node.Right.Range.min - 1L then
            range <- {min = range.min; max = node.Right.Range.max}
            node.Right <- node.Right.Right
        else 
            cleanLeft(node.Right)


    let (|Before|After|BeforeOverlap|AfterOverlap|Superset|Subset|) r = 
        if r.min > range.max + 1L then After
        elif r.min >= range.min then
            if r.max <= range.max then Subset
            else AfterOverlap
        elif r.max < range.min - 1L then Before
        elif r.max <= range.max then
            if r.min >= range.min then Subset
            else BeforeOverlap
        else Superset

    member this.Insert r = 
        match r with
        | After ->
            if right = null then
                right <- Node(null, null, r)
            else
                right.Insert(r)
        | AfterOverlap ->
            range <- {min = range.min; max = r.max}
            mergeRight(this)
        | Before -> 
            if left = null then
                left <- Node(null, null, r)
            else
                left.Insert(r)
        | BeforeOverlap -> 
            range <- {min = r.min; max = range.max}
            mergeLeft(this)
        | Superset ->
            range <- r
            mergeLeft(this)
            mergeRight(this)
        | Subset -> ()

    member this.Left with get() : Node = left and set(x) = left <- x
    member this.Right with get() : Node = right and set(x) = right <- x
    member this.Range with get() : Range = range and set(x) = range <- x

    static member op_Equality (a : Node, b : Node) =
        a.Range = b.Range

    override this.ToString() =
        sprintf "%A" this.Range

type RangeTree() =
    let mutable root = null

    member this.Add(range) =
        if root = null then
            root <- Node(null, null, range)
        else
            root.Insert(range)

    static member fromArray(values : Range seq) =
        let tree = new RangeTree()
        values |> Seq.iter (fun value -> tree.Add(value))
        tree

    member this.Seq 
        with get() =
            let rec inOrder(node : Node) =
                seq {
                    if node <> null then
                        yield! inOrder node.Left
                        yield {min = node.Range.min; max = node.Range.max}
                        yield! inOrder node.Right
                }
            inOrder root

let TestRange() =
    printf "\n"

    let source(n) = 
        let rnd = new Random(n)
        let rand x = rnd.NextDouble() * float x |> int64
        let rangeRnd() =
            let a = rand 1500
            {min = a; max = a + rand 15}
        [|for n in 1 .. 50 do yield rangeRnd()|]

    let shuffle n (array:_[]) =
        let rnd = new Random(n)
        for i in 0 .. array.Length - 1 do
            let n = rnd.Next(i)
            let temp = array.[i]
            array.[i] <- array.[n]
            array.[n] <- temp
        array

    let testRangeAdd n i =
        let dataSet1 = source (n+0)
        let dataSet2 = source (n+1)
        let dataSet3 = source (n+2)
        let result1 = Array.concat [dataSet1; dataSet2; dataSet3] |> shuffle (i+3) |> RangeTree.fromArray 
        let result2 = Array.concat [dataSet2; dataSet3; dataSet1] |> shuffle (i+4) |> RangeTree.fromArray 
        let result3 = Array.concat [dataSet3; dataSet1; dataSet2] |> shuffle (i+5) |> RangeTree.fromArray 
        let test1 = (result1.Seq, result2.Seq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 
        let test2 = (result2.Seq, result3.Seq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 
        let test3 = (result3.Seq, result1.Seq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 

        let print dataSet =
            dataSet |> Seq.iter (fun r -> printf "%s " <| string r)

        if not (test1 && test2 && test3) then
            printf "\n\nTest# %A: " n
            printf "\nSource 1: %A: " (n+0)
            dataSet1 |> print
            printf "\nSource 2: %A: " (n+1)
            dataSet2 |> print
            printf "\nSource 3: %A: " (n+2)
            dataSet3 |> print
            printf "\nResult 1: %A: " (n+0)
            result1.Seq |> print
            printf "\nResult 2: %A: " (n+1)
            result2.Seq |> print
            printf "\nResult 3: %A: " (n+2)
            result3.Seq |> print
            ()

    for i in 1 .. 10 do
        for n in 1 .. 1000 do
            testRangeAdd n i
        printf "\n%d" (i * 1000)

    printf "\nDone"

TestRange()

System.Console.ReadLine() |> ignore

Casos de prueba para el rango

After         (11, 14)      |   | <-->
AfterOverlap  (10, 14)      |   |<--->
AfterOverlap  ( 9, 14)      |   +---->
AfterOverlap  ( 6, 14)      |<--+---->
 "Test Case"  ( 5,  9)      +---+
BeforeOverlap ( 0,  8) <----+-->|
BeforeOverlap ( 0,  5) <----+   |
BeforeOverlap ( 0,  4) <--->|   |
Before        ( 0,  3) <--> |   |
Superset      ( 4, 10)     <+---+>
Subset        ( 5,  9)      +---+
Subset        ( 6,  8)      |<->|

---

Esta no es una respuesta.

Adapté mi caso de prueba para correr contra el código de Julieta. Falla en varios casos, sin embargo, lo veo pasar alguna prueba.

type Range = 
    { min : int64; max : int64 }
with
    override this.ToString() =
        sprintf "(%d, %d)" this.min this.max

let rangeSeqToJTree ranges =
    ranges |> Seq.fold (fun tree range -> tree |> insert (range.min, range.max)) Nil

let JTreeToRangeSeq node =
    let rec inOrder node =
        seq {
            match node with
            | JNode(left, min, max, right) ->
                yield! inOrder left
                yield {min = min; max = max}
                yield! inOrder right
            | Nil -> ()
        }
    inOrder node

let TestJTree() =
    printf "\n"

    let source(n) = 
        let rnd = new Random(n)
        let rand x = rnd.NextDouble() * float x |> int64
        let rangeRnd() =
            let a = rand 15
            {min = a; max = a + rand 5}
        [|for n in 1 .. 5 do yield rangeRnd()|]

    let shuffle n (array:_[]) =
        let rnd = new Random(n)
        for i in 0 .. array.Length - 1 do
            let n = rnd.Next(i)
            let temp = array.[i]
            array.[i] <- array.[n]
            array.[n] <- temp
        array

    let testRangeAdd n i =
        let dataSet1 = source (n+0)
        let dataSet2 = source (n+1)
        let dataSet3 = source (n+2)
        let result1 = Array.concat [dataSet1; dataSet2; dataSet3] |> shuffle (i+3) |> rangeSeqToJTree
        let result2 = Array.concat [dataSet2; dataSet3; dataSet1] |> shuffle (i+4) |> rangeSeqToJTree
        let result3 = Array.concat [dataSet3; dataSet1; dataSet2] |> shuffle (i+5) |> rangeSeqToJTree
        let test1 = (result1 |> JTreeToRangeSeq, result2 |> JTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 
        let test2 = (result2 |> JTreeToRangeSeq, result3 |> JTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 
        let test3 = (result3 |> JTreeToRangeSeq, result1 |> JTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 

        let print dataSet =
            dataSet |> Seq.iter (fun r -> printf "%s " <| string r)

        if not (test1 && test2 && test3) then
            printf "\n\nTest# %A: " n
            printf "\nSource 1: %A: " (n+0)
            dataSet1 |> print
            printf "\nSource 2: %A: " (n+1)
            dataSet2 |> print
            printf "\nSource 3: %A: " (n+2)
            dataSet3 |> print
            printf "\n\nResult 1: %A: " (n+0)
            result1 |> JTreeToRangeSeq |> print
            printf "\nResult 2: %A: " (n+1)
            result2 |> JTreeToRangeSeq |> print
            printf "\nResult 3: %A: " (n+2)
            result3 |> JTreeToRangeSeq |> print
            ()

    for i in 1 .. 1 do
        for n in 1 .. 10 do
            testRangeAdd n i
        printf "\n%d" (i * 10)

    printf "\nDone"

TestJTree()

Answer 1

¡Lo tengo funcionando! Creo que la parte más difícil fue descubrir cómo hacer llamadas recursivas a los niños mientras pasaba el estado de regreso a la pila.

El rendimiento es bastante interesante. Al insertar rangos principalmente que chocan y se fusionan, la versión mutable es más rápida, mientras que si inserta principalmente nodos superpuestos y llena el árbol, la versión inmutable es más rápida. He visto que el rendimiento gira un máximo de 100% en ambos sentidos.

Aquí está el código completo.

module StackOverflowQuestion

open System

type Range = 
    { min : int64; max : int64 }
with
    override this.ToString() =
        sprintf "(%d, %d)" this.min this.max

type RangeTree =
    | Node of RangeTree * int64 * int64 * RangeTree
    | Nil

// Clean right deals with merging when the node to merge with is not on the 
// left outside of the tree.  It travels right inside the tree looking for an 
// overlapping node.  If it finds one it merges the range and replaces the 
// node with its left child thereby deleting it.  If it finds a subset node
// it replaces it with its left child, checks it and continues looking right.
let rec cleanRight n node =
    match node with
    | Node(left, min, max, (Node(left', min', max', right') as right)) -> 
        if n > max' + 1L then
            let node, n' = right |> cleanRight n
            Node(left, min, max, node), n'
        elif n >= min' then
            Node(left, min, max, left'), min'
        else 
            Node(left, min, max, left') |> cleanRight n
    | _ -> node, n

// Symmetric to clean right
let rec cleanLeft x node =
    match node with
    | Node(Node(left', min', max', right') as left, min, max, right) -> 
        if x < min' - 1L then
            let node, x' = left |> cleanLeft x
            Node(node, min, max, right), x'
        elif x <= max' then 
            Node(right', min, max, right), max'
        else 
            Node(right', min, max, right) |> cleanLeft x
        | Nil -> node, x
    | _ -> node, x

// Merger left is called whenever the min value of a node decreases.
// It handles the case of left node overlap/subsets and merging/deleting them.
// When no more overlaps are found on the left nodes it calls clean right.
let rec mergeLeft n node =
    match node with
    | Node(Node(left', min', max', right') as left, min, max, right) -> 
        if n <= min' - 1L then
            Node(left', min, max, right) |> mergeLeft n
        elif n <= max' + 1L then
            Node(left', min', max, right)
        else
            let node, min' = left |> cleanRight n
            Node(node, min', max, right)
    | _ -> node

// Symmetric to merge left
let rec mergeRight x node =
    match node with
    | Node(left, min, max, (Node(left', min', max', right') as right)) -> 
        if x >= max' + 1L then 
            Node(left, min, max, right') |> mergeRight x
        elif x >= min' - 1L then 
            Node(left, min, max', right')
        else 
            let node, max' = right |> cleanLeft x
            Node(left, min, max', node)
    | node -> node

let (|Before|After|BeforeOverlap|AfterOverlap|Superset|Subset|) (min, max, min', max') = 
    if min > max' + 1L then After
    elif min >= min' then
        if max <= max' then Subset
        else AfterOverlap
    elif max < min' - 1L then Before
    elif max <= max' then
        if min >= min' then Subset
        else BeforeOverlap
    else Superset

let rec insert min' max' this = 
    match this with
    | Node(left, min, max, right) ->
        match (min', max', min, max) with
        | After         -> Node(left, min, max, right |> insert min' max')
        | AfterOverlap  -> Node(left, min, max', right) |> mergeRight max'
        | Before        -> Node(left |> insert min' max', min, max, right)
        | BeforeOverlap -> Node(left, min', max, right) |> mergeLeft min'
        | Superset      -> Node(left, min', max', right) |> mergeLeft min' |> mergeRight max'
        | Subset        -> this
    | Nil -> Node(Nil, min', max', Nil)

let rangeSeqToRangeTree ranges =
    ranges |> Seq.fold (fun tree range -> tree |> insert range.min range.max) Nil

let rangeTreeToRangeSeq node =
    let rec inOrder node =
        seq {
            match node with
            | Node(left, min, max, right) ->
                yield! inOrder left
                yield {min = min; max = max}
                yield! inOrder right
            | Nil -> ()
        }
    inOrder node

let TestImmutableRangeTree() =
    printf "\n"

    let source(n) = 
        let rnd = new Random(n)
        let rand x = rnd.NextDouble() * float x |> int64
        let rangeRnd() =
            let a = rand 15000
            {min = a; max = a + rand 150}
        [|for n in 1 .. 200 do yield rangeRnd()|]

    let shuffle n (array:_[]) =
        let rnd = new Random(n)
        for i in 0 .. array.Length - 1 do
            let n = rnd.Next(i)
            let temp = array.[i]
            array.[i] <- array.[n]
            array.[n] <- temp
        array

    let print dataSet =
        dataSet |> Seq.iter (fun r -> printf "%s " <| string r)

    let testRangeAdd n i =
        let dataSet1 = source (n+0)
        let dataSet2 = source (n+1)
        let dataSet3 = source (n+2)
        let result1 = Array.concat [dataSet1; dataSet2; dataSet3] |> shuffle (i+3) |> rangeSeqToRangeTree
        let result2 = Array.concat [dataSet2; dataSet3; dataSet1] |> shuffle (i+4) |> rangeSeqToRangeTree
        let result3 = Array.concat [dataSet3; dataSet1; dataSet2] |> shuffle (i+5) |> rangeSeqToRangeTree
        let test1 = (result1 |> rangeTreeToRangeSeq, result2 |> rangeTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 
        let test2 = (result2 |> rangeTreeToRangeSeq, result3 |> rangeTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 
        let test3 = (result3 |> rangeTreeToRangeSeq, result1 |> rangeTreeToRangeSeq) ||> Seq.forall2 (fun a b -> a.min = b.min && a.max = b.max) 

        if not (test1 && test2 && test3) then
            printf "\n\nTest# %A: " n
            printf "\nSource 1: %A: " (n+0)
            dataSet1 |> print
            printf "\nSource 2: %A: " (n+1)
            dataSet2 |> print
            printf "\nSource 3: %A: " (n+2)
            dataSet3 |> print
            printf "\n\nResult 1: %A: " (n+0)
            result1 |> rangeTreeToRangeSeq |> print
            printf "\nResult 2: %A: " (n+1)
            result2 |> rangeTreeToRangeSeq |> print
            printf "\nResult 3: %A: " (n+2)
            result3 |> rangeTreeToRangeSeq |> print
            ()

    for i in 1 .. 10 do
        for n in 1 .. 100 do
            testRangeAdd n i
        printf "\n%d" (i * 10)

    printf "\nDone"

TestImmutableRangeTree()

System.Console.ReadLine() |> ignore

Answer 2

Parece que estás definiendo un árbol binario que es básicamente una unión de un montón de rangos. Entonces, tienes los siguientes escenarios:

     (10, 20)              left                    (10, 20)
    /       \                -->                   /      \
(0, 5)       (25, 30)      (7, 8)             (7, 8)      (25, 30)
                                             /
                                        (0, 5)


     (10, 20)              right                   (10, 20)
    /       \                -->                   /      \
(0, 5)       (25, 30)      (21, 22)           (0, 5)      (21, 22)
                                                                 \
                                                                  (25, 30)


     (10, 20)              subset                  (10, 20)
    /       \                -->                   /      \
(0, 5)       (25, 30)      (15, 19)           (0, 5)      (25, 30)



     (10, 20)              R-superset               (10, 30)
    /       \                -->                   /
(0, 5)       (25, 30)      (11, 30)           (0, 5)



     (10, 20)              L-superset                (0, 20)
    /       \                -->                           \
(0, 5)       (25, 30)      (0, 10)                          (25, 30)



     (10, 20)              LR-superset               (0, 30)
    /       \                -->
(0, 5)       (25, 30)      (0, 30)

Los casos L-R y LR-Superset son interesantes porque requiere fusionar/eliminar nodos cuando inserta un nodo cuyo rango ya contiene otros nodos.

Lo siguiente se escribe apresuradamente y no se prueba muy bien, pero parece satisfacer la definición simple anterior:

type JTree =
    | JNode of JTree * int64 * int64 * JTree
    | Nil

let rec merge = function
    | JNode(JNode(ll, lmin, lmax, lr), min, max, r) when min <= lmin -> merge <| JNode(ll, min, max, r)
    | JNode(l, min, max, JNode(rl, rmin, rmax, rr)) when max >= rmax -> merge <| JNode(l, min, max, rr)
    | n -> n

let rec insert (min, max) = function
    | JNode(l, min', max', r) ->
        let node =
            // equal.
            // e.g. Given Node(l, 10, 20, r) insert (10, 20)
            if min' = min && max' = max then JNode(l, min', max', r)

            // before. Insert left
            // e.g. Given Node(l, 10, 20, r) insert (5, 7)
            elif min' >= max then JNode(insert (min, max) l, min', max', r)

            // after. Insert right
            // e.g. Given Node(l, 10, 20, r) insert (30, 40)
            elif max' <= min then JNode(l, min', max', insert (min, max) r)

            // superset
            // e.g. Given Node(l, 10, 20, r) insert (0, 40)
            elif min' >= min && max' <= max then JNode(l, min, max, r)

            // overlaps left
            // e.g. Given Node(l, 10, 20, r) insert (5, 15)
            elif min' >= min && max' >= max then JNode(l, min, max', r)

            // overlaps right
            // e.g. Given Node(l, 10, 20, r) insert (15, 40)
            elif min' <= min && max' <= max then JNode(l, min', max, r)

            // subset.
            // e.g. Given Node(l, 10, 20, r) insert (15, 17)
            elif min' <= min && max >= max then JNode(l, min', max', r)

            // shouldn't happen
            else failwith "insert (%i, %i) into Node(l, %i, %i, r)" min max min' max'

        // balances left and right sides
        merge node
    | Nil -> JNode(Nil, min, max, Nil)

Jtree = juliet árbol :) el merge La función hace todo el trabajo pesado. Se fusionará lo más posible por la columna izquierda, luego lo más posible por la columna derecha.

No estoy totalmente convencido de que mi overlaps left y overlaps right Los casos se implementan correctamente, pero los otros casos deben ser correctos.