From 769667e1f02c754b40e01c207c30c6790e5fe169 Mon Sep 17 00:00:00 2001 From: Egor Starikov Date: Thu, 30 Apr 2026 19:11:51 +0300 Subject: [PATCH 1/5] set on red-black tree --- QuadTree.Tests/QuadTree.Tests.fsproj | 1 + QuadTree.Tests/Tests.RedBlackSet.fs | 199 ++++++++++++++++ QuadTree/QuadTree.fsproj | 1 + QuadTree/RedBlackSet.fs | 330 +++++++++++++++++++++++++++ 4 files changed, 531 insertions(+) create mode 100644 QuadTree.Tests/Tests.RedBlackSet.fs create mode 100644 QuadTree/RedBlackSet.fs diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 96f4102..bfbc403 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -13,6 +13,7 @@ + diff --git a/QuadTree.Tests/Tests.RedBlackSet.fs b/QuadTree.Tests/Tests.RedBlackSet.fs new file mode 100644 index 0000000..ea3a79f --- /dev/null +++ b/QuadTree.Tests/Tests.RedBlackSet.fs @@ -0,0 +1,199 @@ +module RedBlackSet.Tests + +open System +open RedBlackSet +open Xunit + +let rec blHeightInv tree = + match tree with + | Empty -> 0 + | Node(color, l, _, r) -> + let lH = blHeightInv l + let rH = blHeightInv r + if lH = -1 || rH = -1 || lH <> rH then + -1 + else if color = Red then + lH + else + lH + 1 + +let rec heightInv tree = + match tree with + | Empty -> 0 + | Node(_, l, _, r) -> + let lH = heightInv l + let rH = heightInv r + if lH > rH then + if lH = -1 || rH = -1 || (float (lH + 1) / float (rH + 1) > 2) then + -1 + else + lH + else + if lH = -1 || rH = -1 || (float (rH + 1) / float (lH + 1) > 2) then + -1 + else + rH + +let rec blackSonsOfRed tree = + match tree with + | Empty -> true + | Node(Red, Node(Red, _,_ , _) , _, _) -> false + | Node(Red, _, _, Node(Red, _, _, _)) -> false + | Node(_, l, _, r) -> + blackSonsOfRed l && blackSonsOfRed r + +let rec numOfElements tree num = + match tree with + | Empty -> 0 + | Node(_, l, _, r) -> + let lN = numOfElements l num + let rN = numOfElements r num + lN + rN + 1 + +[] +let oneElement() = + let t1 = emptySet + let t2 = insert t1 4 + let t3 = insert t2 4 + Assert.True(contains t3 4) + Assert.Equal(1, blHeightInv t3) + Assert.NotEqual(-1, heightInv t3) + Assert.True(blackSonsOfRed t3) + Assert.Equal(1, numOfElements t3 0) + +[] +let insertSomeElem() = + let t1 = emptySet + let t2 = insert t1 5 + let t3 = insert t2 9 + let t4 = insert t3 -7 + let t5 = insert t4 89 + let t6 = insert t5 -27 + let t7 = insert t6 13 + Assert.True(contains t7 -7) + Assert.Equal(2, blHeightInv t7) + Assert.NotEqual(-1, heightInv t7) + Assert.True(blackSonsOfRed t7) + Assert.Equal(6, numOfElements t7 0) + +[] +let deleteSomeElem() = + let t1 = emptySet + let t2 = insert t1 5 + let t3 = insert t2 9 + let t4 = insert t3 -7 + let t5 = insert t4 89 + let t6 = insert t5 -27 + let t7 = insert t6 13 + let t8 = delete t7 99 + let t9 = delete t8 13 + Assert.False(contains t9 13) + Assert.Equal(2, blHeightInv t9) + Assert.NotEqual(-1, heightInv t9) + Assert.True(blackSonsOfRed t9) + Assert.Equal(5, numOfElements t9 0) + +[] +let unionSets() = + let t1 = emptySet + let t2 = insert t1 5 + let t3 = insert t2 9 + let t4 = insert t3 -7 + let t5 = insert t4 89 + let t6 = insert t5 -27 + let t7 = insert t6 13 + + let t1' = emptySet + let t2' = insert t1' 2 + let t3' = insert t2' 7 + let t4' = insert t3' 21 + let t5' = insert t4' 9 + let t6' = insert t5' 5 + + let tU = union t7 t6' + Assert.NotEqual(-1, heightInv tU) + Assert.True(blackSonsOfRed tU) + Assert.Equal(9, numOfElements tU 0) + +[] +let intersectionSets() = + let t1 = emptySet + let t2 = insert t1 5 + let t3 = insert t2 9 + let t4 = insert t3 -7 + let t5 = insert t4 89 + let t6 = insert t5 -27 + let t7 = insert t6 13 + + let t1' = emptySet + let t2' = insert t1' 2 + let t3' = insert t2' 7 + let t4' = insert t3' 21 + let t5' = insert t4' 9 + let t6' = insert t5' 5 + + let tI = intersection t7 t6' + Assert.NotEqual(-1, heightInv tI) + Assert.True(blackSonsOfRed tI) + Assert.Equal(2, numOfElements tI 0) + +[] +let differenceSets() = + let t1 = emptySet + let t2 = insert t1 5 + let t3 = insert t2 9 + let t4 = insert t3 -7 + let t5 = insert t4 89 + let t6 = insert t5 -27 + let t7 = insert t6 13 + + let t1' = emptySet + let t2' = insert t1' 2 + let t3' = insert t2' 7 + let t4' = insert t3' 21 + let t5' = insert t4' 9 + let t6' = insert t5' 5 + + let tD = difference t7 t6' + Assert.NotEqual(-1, heightInv tD) + Assert.True(blackSonsOfRed tD) + Assert.Equal(4, numOfElements tD 0) + +[] +let emptySetProperties() = + let t = emptySet + Assert.False(contains t 0) + Assert.Equal(0, numOfElements t 0) + Assert.Equal(0, blHeightInv t) + Assert.True(blackSonsOfRed t) + +[] +let largeSetInsertion() = + let randomValues = [for i in 1..1000 -> Random().Next(-10000, 10000)] + let tree = Seq.fold (fun acc x -> insert acc x) emptySet randomValues + + Assert.NotEqual(-1, blHeightInv tree) + Assert.True(blackSonsOfRed tree) + + for x in randomValues do + Assert.True(contains tree x) + +[] +let deleteRoot() = + let t1 = insert emptySet 5 + let t2 = insert t1 3 + let t3 = insert t2 7 + let t4 = delete t3 5 + + Assert.False(contains t4 5) + Assert.True(contains t4 3) + Assert.True(contains t4 7) + Assert.NotEqual(-1, blHeightInv t4) + +[] +let complexRedBlackViolations() = + let values = [1..20] + let tree = Seq.fold (fun acc x -> insert acc x) emptySet values + + Assert.NotEqual(-1, blHeightInv tree) + Assert.True(blackSonsOfRed tree) diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 2b2b699..9ad6c58 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -13,6 +13,7 @@ + diff --git a/QuadTree/RedBlackSet.fs b/QuadTree/RedBlackSet.fs new file mode 100644 index 0000000..1d4ce51 --- /dev/null +++ b/QuadTree/RedBlackSet.fs @@ -0,0 +1,330 @@ +//в качестве референса использовались "Faster, Simpler Red-Black Trees" и Data/Set/RBTree.hs +module RedBlackSet + +type Color = + | Red + | Black + +type Tree<'T> = + | Empty + | Node of color: Color * left: Tree<'T> * value: 'T * right: Tree<'T> + +let emptySet = Empty + +//оболочка, чтобы понимать, надо ли вызывать балансировку на следующих шагах рекурсии +type private Result<'T> = + | Done of 'T + | ToDo of 'T + +//перекраска листа в черный +let private blacken tree = + match tree with + | Node(Red, a, x, b) -> Done(Node(Black, a, x, b)) + | _ -> ToDo tree + +//убирает оболочку +let private justTree resultTree = + match resultTree with + | Done t -> t + | ToDo t -> t + +//считает черную высоту +let rec private blackHeight tree = + match tree with + | Empty -> 0 + | Node(Red, l, _, _) -> blackHeight l + | Node(Black, l, _, _) -> 1 + (blackHeight l) + + +//проверка на наличие +let rec contains tree v = + match tree with + | Empty -> false + | Node(_, left, value, right) -> + if value > v then contains left v + elif value < v then contains right v + else true + +//балансировка +let private balance tree = + match tree with + | Node(Black, Node(Red, Node(Red, a, x, b), y, c), z, d) + | Node(Black, Node(Red, a, x, Node(Red, b, y, c)), z, d) + | Node(Black, a, x, Node(Red, Node(Red, b, y, c), z, d)) + | Node(Black, a, x, Node(Red, b, y, Node(Red, c, z, d))) -> + ToDo(Node(Red, Node(Black, a, x, b), y, Node(Black, c, z, d))) + | Node(Black, a, x, b) as n -> Done(n) + | _ -> ToDo(tree) + +//вставка +let insert tree v = + + let rec insertRec tree v = + match tree with + | Empty -> ToDo(Node(Red, Empty, v, Empty)) + | Node(color, left, value, right) -> + if value > v then + let newLeft = insertRec left v + + match newLeft with + | Done nl -> Done(Node(color, nl, value, right)) + | ToDo nl -> balance (Node(color, nl, value, right)) + elif value < v then + let newRight = insertRec right v + + match newRight with + | Done nr -> Done(Node(color, left, value, nr)) + | ToDo nr -> balance (Node(color, left, value, nr)) + else + Done(tree) + + let newTree = insertRec tree v + newTree |> justTree |> blacken |> justTree + +//удаление +let delete tree v = + + let balanceDel tree = + match tree with + | Node(color, Node(Red, Node(Red, a, x, b), y, c), z, d) + | Node(color, Node(Red, a, x, Node(Red, b, y, c)), z, d) + | Node(color, a, x, Node(Red, Node(Red, b, y, c), z, d)) + | Node(color, a, x, Node(Red, b, y, Node(Red, c, z, d))) -> + Done(Node(color, Node(Black, a, x, b), y, Node(Black, c, z, d))) + | _ -> blacken tree + + let rec eqL tree = + match tree with + | Node(color, a, x, Node(Black, b, y, c)) -> balanceDel (Node(color, a, x, Node(Red, b, y, c))) + | Node(color, a, x, Node(Red, b, y, c)) -> + let newLeft = eqL (Node(Red, a, x, b)) + + match newLeft with + | Done nl -> Done(Node(Black, nl, y, c)) + | ToDo nl -> ToDo(Node(Black, nl, y, c)) + | _ -> failwith "Impossible pattern" + + let rec eqR tree = + match tree with + | Node(color, Node(Black, a, x, b), y, c) -> balanceDel (Node(color, Node(Red, a, x, b), y, c)) + | Node(color, Node(Red, a, x, b), y, c) -> + let newRight = eqR (Node(Red, b, y, c)) + + match newRight with + | Done nr -> Done(Node(Black, a, x, nr)) + | ToDo nr -> ToDo(Node(Black, a, x, nr)) + | _ -> failwith "Impossible pattern" + + let delCur tree = + + let rec delMin tree = + match tree with + | Node(Red, Empty, x, b) -> (Done b, x) + | Node(Black, Empty, x, b) -> (blacken b, x) + | Node(color, a, x, b) -> + let (an, min) = delMin a + + match an with + | Done t -> (Done(Node(color, t, x, b)), min) + | ToDo t -> (eqL (Node(color, t, x, b)), min) + | _ -> failwith "Impossible pattern" + + match tree with + | Node(Red, a, y, Empty) -> Done a + | Node(Black, a, x, Empty) -> blacken a + | Node(color, a, x, b) -> + let (bn, min) = delMin b + + match bn with + | Done t -> Done(Node(color, a, min, t)) + | ToDo t -> eqR (Node(color, a, min, t)) + | _ -> failwith "Impossible pattern" + + let rec deleteRec tree v = + match tree with + | Empty -> Done(Empty) + | Node(color, left, value, right) -> + if value > v then + let newLeft = deleteRec left v + + match newLeft with + | Done nl -> Done(Node(color, nl, value, right)) + | ToDo nl -> eqL (Node(color, nl, value, right)) + elif value < v then + let newRight = deleteRec right v + + match newRight with + | Done nr -> Done(Node(color, left, value, nr)) + | ToDo nr -> eqR (Node(color, left, value, nr)) + else + delCur tree + + let newTree = deleteRec tree v + newTree |> justTree |> blacken |> justTree + +//join +let join t1 g t2 = + + let rec joinLT t1 g t2 targetHeight currentHeight = + if targetHeight = currentHeight then + Node(Red, t1, g, t2) + else + match t2 with + | Node(Red, l, x, r) -> + let newLeft = joinLT t1 g l targetHeight currentHeight + Node(Red, newLeft, x, r) |> balance |> justTree + | Node(Black, l, x, r) -> + let newLeft = joinLT t1 g l targetHeight (currentHeight - 1) + Node(Black, newLeft, x, r) |> balance |> justTree + | _ -> failwith "Impossible pattern" + + let rec joinRT t1 g t2 targetHeight currentHeight = + if targetHeight = currentHeight then + Node(Red, t1, g, t2) + else + match t1 with + | Node(Red, l, x, r) -> + let newRight = joinRT t2 g r targetHeight currentHeight + Node(Red, l, x, newRight) |> balance |> justTree + | Node(Black, l, x, r) -> + let newRight = joinRT t2 g r targetHeight (currentHeight - 1) + Node(Black, l, x, newRight) |> balance |> justTree + | _ -> failwith "Impossible pattern" + + let h1 = blackHeight t1 + let h2 = blackHeight t2 + + if h1 = 0 then + insert t2 g + else if h2 = 0 then + insert t1 g + else if h1 < h2 then + let t = joinLT t1 g t2 h1 h2 + + t |> blacken |> justTree + else if h1 > h2 then + let t = joinRT t1 g t2 h2 h1 + + t |> blacken |> justTree + else + Node(Black, t1, g, t2) + +//merge +let merge t1 t2 = + + let rec minimum tree = + match tree with + | Node(_, Empty, x, _) -> x + | Node(_, l, _, _) -> minimum l + | _ -> failwith "Impossible pattern" + + let mergeEQ t1 t2 = + let m = minimum t2 + let t2' = delete t2 m + let h2' = blackHeight t2' + let h1 = blackHeight t1 + + if h1 = h2' then + Node(Red, t1, m, t2') + else + match t1 with + | Node(_, Node(Red, ll, lx, lr), x, r) -> Node(Red, Node(Black, ll, lx, lr), x, Node(Black, r, m, t2')) + | Node(_, l, x, Node(Red, rl, rx, rr)) -> Node(Black, Node(Red, l, x, rl), rx, Node(Red, rr, m, t2')) + | _ -> Node(Black, (justTree (blacken t1)), m, t2') + + let rec mergeLT t1 t2 targetHeight currentHeight = + if targetHeight = currentHeight then + mergeEQ t1 t2 + else + match t2 with + | Node(Red, l, x, r) -> + let newLeft = mergeLT t1 l targetHeight currentHeight + Node(Red, newLeft, x, r) |> balance |> justTree + | Node(Black, l, x, r) -> + let newLeft = mergeLT t1 l targetHeight (currentHeight - 1) + Node(Red, newLeft, x, r) |> balance |> justTree + | _ -> failwith "Impossible pattern" + + let rec mergeRT t1 t2 targetHeight currentHeight = + if targetHeight = currentHeight then + mergeEQ t1 t2 + else + match t1 with + | Node(Red, l, x, r) -> + let newRight = mergeRT r t2 targetHeight currentHeight + Node(Red, l, x, newRight) |> balance |> justTree + | Node(Black, l, x, r) -> + let newRight = mergeRT r t2 targetHeight (currentHeight - 1) + Node(Red, l, x, newRight) |> balance |> justTree + | _ -> failwith "Impossible pattern" + + let h1 = blackHeight t1 + let h2 = blackHeight t2 + + if h1 = 0 then + t2 + else if h2 = 0 then + t1 + else if h1 < h2 then + let t = mergeLT t1 t2 h1 h2 + + t |> blacken |> justTree + else if h1 > h2 then + let t = mergeRT t1 t2 h2 h1 + + t |> blacken |> justTree + else + let t = mergeEQ t1 t2 + t |> blacken |> justTree + +//split +let rec split kx tree = + match tree with + | Empty -> (Empty, Empty) + | Node(_, l, x, r) -> + if kx < x then + let (lt, gt) = split kx l + (lt, join gt x (justTree (blacken r))) + else if kx > x then + let (lt, gt) = split kx r + (join (justTree (blacken l)) x lt, gt) + else + (justTree (blacken (l)), justTree (blacken (r))) + + +//объединение +let rec union t1 t2 = + match t1 with + | Empty -> t2 + | _ -> + match t2 with + | Empty -> t1 + | Node(_, l, x, r) -> + let (l', r') = split x t1 + join (union l' l) x (union r' r) + +//пересечение +let rec intersection t1 t2 = + match t1 with + | Empty -> Empty + | _ -> + match t2 with + | Empty -> Empty + | Node(_, l, x, r) -> + let (l', r') = split x t1 + + if contains t1 x then + join (intersection l' l) x (intersection r' r) + else + merge (intersection l' l) (intersection r' r) + +//разность +let rec difference t1 t2 = + match t1 with + | Empty -> Empty + | _ -> + match t2 with + | Empty -> t1 + | Node(_, l, x, r) -> + let (l', r') = split x t1 + merge (difference l' l) (difference r' r) From 0296f05bf49451445ff0339495b6e20790c3e549 Mon Sep 17 00:00:00 2001 From: Egor Starikov Date: Thu, 30 Apr 2026 19:32:27 +0300 Subject: [PATCH 2/5] formatted Tests.RedBlackSet.fs --- QuadTree.Tests/Tests.RedBlackSet.fs | 87 ++++++++++++++--------------- 1 file changed, 42 insertions(+), 45 deletions(-) diff --git a/QuadTree.Tests/Tests.RedBlackSet.fs b/QuadTree.Tests/Tests.RedBlackSet.fs index ea3a79f..ad6d4de 100644 --- a/QuadTree.Tests/Tests.RedBlackSet.fs +++ b/QuadTree.Tests/Tests.RedBlackSet.fs @@ -4,54 +4,51 @@ open System open RedBlackSet open Xunit -let rec blHeightInv tree = - match tree with +let rec blHeightInv tree = + match tree with | Empty -> 0 - | Node(color, l, _, r) -> - let lH = blHeightInv l + | Node(color, l, _, r) -> + let lH = blHeightInv l let rH = blHeightInv r - if lH = -1 || rH = -1 || lH <> rH then - -1 - else if color = Red then - lH - else - lH + 1 + + if lH = -1 || rH = -1 || lH <> rH then -1 + else if color = Red then lH + else lH + 1 let rec heightInv tree = - match tree with + match tree with | Empty -> 0 - | Node(_, l, _, r) -> + | Node(_, l, _, r) -> let lH = heightInv l let rH = heightInv r - if lH > rH then - if lH = -1 || rH = -1 || (float (lH + 1) / float (rH + 1) > 2) then + + if lH > rH then + if lH = -1 || rH = -1 || (float (lH + 1) / float (rH + 1) > 2) then -1 - else + else lH - else - if lH = -1 || rH = -1 || (float (rH + 1) / float (lH + 1) > 2) then - -1 - else - rH + else if lH = -1 || rH = -1 || (float (rH + 1) / float (lH + 1) > 2) then + -1 + else + rH let rec blackSonsOfRed tree = - match tree with + match tree with | Empty -> true - | Node(Red, Node(Red, _,_ , _) , _, _) -> false + | Node(Red, Node(Red, _, _, _), _, _) -> false | Node(Red, _, _, Node(Red, _, _, _)) -> false - | Node(_, l, _, r) -> - blackSonsOfRed l && blackSonsOfRed r + | Node(_, l, _, r) -> blackSonsOfRed l && blackSonsOfRed r -let rec numOfElements tree num = +let rec numOfElements tree num = match tree with | Empty -> 0 | Node(_, l, _, r) -> let lN = numOfElements l num let rN = numOfElements r num - lN + rN + 1 + lN + rN + 1 [] -let oneElement() = +let oneElement () = let t1 = emptySet let t2 = insert t1 4 let t3 = insert t2 4 @@ -62,7 +59,7 @@ let oneElement() = Assert.Equal(1, numOfElements t3 0) [] -let insertSomeElem() = +let insertSomeElem () = let t1 = emptySet let t2 = insert t1 5 let t3 = insert t2 9 @@ -77,7 +74,7 @@ let insertSomeElem() = Assert.Equal(6, numOfElements t7 0) [] -let deleteSomeElem() = +let deleteSomeElem () = let t1 = emptySet let t2 = insert t1 5 let t3 = insert t2 9 @@ -94,7 +91,7 @@ let deleteSomeElem() = Assert.Equal(5, numOfElements t9 0) [] -let unionSets() = +let unionSets () = let t1 = emptySet let t2 = insert t1 5 let t3 = insert t2 9 @@ -110,13 +107,13 @@ let unionSets() = let t5' = insert t4' 9 let t6' = insert t5' 5 - let tU = union t7 t6' + let tU = union t7 t6' Assert.NotEqual(-1, heightInv tU) Assert.True(blackSonsOfRed tU) Assert.Equal(9, numOfElements tU 0) [] -let intersectionSets() = +let intersectionSets () = let t1 = emptySet let t2 = insert t1 5 let t3 = insert t2 9 @@ -132,13 +129,13 @@ let intersectionSets() = let t5' = insert t4' 9 let t6' = insert t5' 5 - let tI = intersection t7 t6' + let tI = intersection t7 t6' Assert.NotEqual(-1, heightInv tI) Assert.True(blackSonsOfRed tI) Assert.Equal(2, numOfElements tI 0) [] -let differenceSets() = +let differenceSets () = let t1 = emptySet let t2 = insert t1 5 let t3 = insert t2 9 @@ -154,13 +151,13 @@ let differenceSets() = let t5' = insert t4' 9 let t6' = insert t5' 5 - let tD = difference t7 t6' + let tD = difference t7 t6' Assert.NotEqual(-1, heightInv tD) Assert.True(blackSonsOfRed tD) Assert.Equal(4, numOfElements tD 0) [] -let emptySetProperties() = +let emptySetProperties () = let t = emptySet Assert.False(contains t 0) Assert.Equal(0, numOfElements t 0) @@ -168,32 +165,32 @@ let emptySetProperties() = Assert.True(blackSonsOfRed t) [] -let largeSetInsertion() = - let randomValues = [for i in 1..1000 -> Random().Next(-10000, 10000)] +let largeSetInsertion () = + let randomValues = [ for i in 1..1000 -> Random().Next(-10000, 10000) ] let tree = Seq.fold (fun acc x -> insert acc x) emptySet randomValues - + Assert.NotEqual(-1, blHeightInv tree) Assert.True(blackSonsOfRed tree) - + for x in randomValues do Assert.True(contains tree x) [] -let deleteRoot() = +let deleteRoot () = let t1 = insert emptySet 5 let t2 = insert t1 3 let t3 = insert t2 7 let t4 = delete t3 5 - + Assert.False(contains t4 5) Assert.True(contains t4 3) Assert.True(contains t4 7) Assert.NotEqual(-1, blHeightInv t4) [] -let complexRedBlackViolations() = - let values = [1..20] +let complexRedBlackViolations () = + let values = [ 1..20 ] let tree = Seq.fold (fun acc x -> insert acc x) emptySet values - + Assert.NotEqual(-1, blHeightInv tree) Assert.True(blackSonsOfRed tree) From 889a8961717ab5a0aded86c4ac2e17253ca2b879 Mon Sep 17 00:00:00 2001 From: Egor Starikov Date: Fri, 1 May 2026 13:02:21 +0300 Subject: [PATCH 3/5] add private merge, split, join --- QuadTree/RedBlackSet.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/QuadTree/RedBlackSet.fs b/QuadTree/RedBlackSet.fs index 1d4ce51..7d61b4c 100644 --- a/QuadTree/RedBlackSet.fs +++ b/QuadTree/RedBlackSet.fs @@ -163,7 +163,7 @@ let delete tree v = newTree |> justTree |> blacken |> justTree //join -let join t1 g t2 = +let private join t1 g t2 = let rec joinLT t1 g t2 targetHeight currentHeight = if targetHeight = currentHeight then @@ -210,7 +210,7 @@ let join t1 g t2 = Node(Black, t1, g, t2) //merge -let merge t1 t2 = +let private merge t1 t2 = let rec minimum tree = match tree with @@ -278,7 +278,7 @@ let merge t1 t2 = t |> blacken |> justTree //split -let rec split kx tree = +let rec private split kx tree = match tree with | Empty -> (Empty, Empty) | Node(_, l, x, r) -> From f1b878045f54e70c69786f371085a6e74f3fb223 Mon Sep 17 00:00:00 2001 From: Egor Starikov Date: Tue, 5 May 2026 21:14:07 +0300 Subject: [PATCH 4/5] fix comments --- QuadTree/RedBlackSet.fs | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/QuadTree/RedBlackSet.fs b/QuadTree/RedBlackSet.fs index 7d61b4c..78d1518 100644 --- a/QuadTree/RedBlackSet.fs +++ b/QuadTree/RedBlackSet.fs @@ -1,4 +1,4 @@ -//в качестве референса использовались "Faster, Simpler Red-Black Trees" и Data/Set/RBTree.hs +//The following sources were used as a reference: 'Faster, Simpler Red-Black Trees' and Data/Set/RBTree.hs. module RedBlackSet type Color = @@ -11,24 +11,20 @@ type Tree<'T> = let emptySet = Empty -//оболочка, чтобы понимать, надо ли вызывать балансировку на следующих шагах рекурсии type private Result<'T> = | Done of 'T | ToDo of 'T -//перекраска листа в черный let private blacken tree = match tree with | Node(Red, a, x, b) -> Done(Node(Black, a, x, b)) | _ -> ToDo tree -//убирает оболочку let private justTree resultTree = match resultTree with | Done t -> t | ToDo t -> t -//считает черную высоту let rec private blackHeight tree = match tree with | Empty -> 0 @@ -36,7 +32,6 @@ let rec private blackHeight tree = | Node(Black, l, _, _) -> 1 + (blackHeight l) -//проверка на наличие let rec contains tree v = match tree with | Empty -> false @@ -45,7 +40,6 @@ let rec contains tree v = elif value < v then contains right v else true -//балансировка let private balance tree = match tree with | Node(Black, Node(Red, Node(Red, a, x, b), y, c), z, d) @@ -56,7 +50,6 @@ let private balance tree = | Node(Black, a, x, b) as n -> Done(n) | _ -> ToDo(tree) -//вставка let insert tree v = let rec insertRec tree v = @@ -81,7 +74,6 @@ let insert tree v = let newTree = insertRec tree v newTree |> justTree |> blacken |> justTree -//удаление let delete tree v = let balanceDel tree = @@ -162,7 +154,6 @@ let delete tree v = let newTree = deleteRec tree v newTree |> justTree |> blacken |> justTree -//join let private join t1 g t2 = let rec joinLT t1 g t2 targetHeight currentHeight = @@ -209,7 +200,6 @@ let private join t1 g t2 = else Node(Black, t1, g, t2) -//merge let private merge t1 t2 = let rec minimum tree = @@ -277,7 +267,6 @@ let private merge t1 t2 = let t = mergeEQ t1 t2 t |> blacken |> justTree -//split let rec private split kx tree = match tree with | Empty -> (Empty, Empty) @@ -292,7 +281,6 @@ let rec private split kx tree = (justTree (blacken (l)), justTree (blacken (r))) -//объединение let rec union t1 t2 = match t1 with | Empty -> t2 @@ -303,7 +291,6 @@ let rec union t1 t2 = let (l', r') = split x t1 join (union l' l) x (union r' r) -//пересечение let rec intersection t1 t2 = match t1 with | Empty -> Empty @@ -318,7 +305,6 @@ let rec intersection t1 t2 = else merge (intersection l' l) (intersection r' r) -//разность let rec difference t1 t2 = match t1 with | Empty -> Empty From 91c4eeb442aa7035d5a355764862fa76e06aedfb Mon Sep 17 00:00:00 2001 From: Egor Starikov Date: Tue, 5 May 2026 21:22:47 +0300 Subject: [PATCH 5/5] Trigger PR creation after close