module Data.RedBlackTree.InsertionAlgorithm (
identifyRBTCase,
insert,
RBTCase (Case1, Case2, Case3, Case4, Case5)
) where
import Data.RedBlackTree.BinaryTree
import Data.RedBlackTree.TreeFamily
import Data.RedBlackTree.Internal
data RBTCase a
= Case1 (WhiteBranch a)
| Case2 (RedBlackDirections a) (RedBlackBranch a)
| Case3 (RedBlackDirections a) a (WhiteBranch a) (WhiteBranch a)
| Case4 (RedBlackDirections a) (RedBlackDirection a) (RedBlackNode a)
(RedBlackTree a) (RedBlackBranch a)
| Case5 (RedBlackDirections a) (RedBlackDirection a) a (RedBlackTree a)
(RedBlackBranch a)
deriving (RBTCase a -> RBTCase a -> Bool
(RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool) -> Eq (RBTCase a)
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
== :: RBTCase a -> RBTCase a -> Bool
$c/= :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
/= :: RBTCase a -> RBTCase a -> Bool
Eq, Eq (RBTCase a)
Eq (RBTCase a) =>
(RBTCase a -> RBTCase a -> Ordering)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> Bool)
-> (RBTCase a -> RBTCase a -> RBTCase a)
-> (RBTCase a -> RBTCase a -> RBTCase a)
-> Ord (RBTCase a)
RBTCase a -> RBTCase a -> Bool
RBTCase a -> RBTCase a -> Ordering
RBTCase a -> RBTCase a -> RBTCase a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. BinaryTreeNode a => Eq (RBTCase a)
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Ordering
forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> RBTCase a
$ccompare :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Ordering
compare :: RBTCase a -> RBTCase a -> Ordering
$c< :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
< :: RBTCase a -> RBTCase a -> Bool
$c<= :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
<= :: RBTCase a -> RBTCase a -> Bool
$c> :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
> :: RBTCase a -> RBTCase a -> Bool
$c>= :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> Bool
>= :: RBTCase a -> RBTCase a -> Bool
$cmax :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> RBTCase a
max :: RBTCase a -> RBTCase a -> RBTCase a
$cmin :: forall a. BinaryTreeNode a => RBTCase a -> RBTCase a -> RBTCase a
min :: RBTCase a -> RBTCase a -> RBTCase a
Ord, Int -> RBTCase a -> ShowS
[RBTCase a] -> ShowS
RBTCase a -> String
(Int -> RBTCase a -> ShowS)
-> (RBTCase a -> String)
-> ([RBTCase a] -> ShowS)
-> Show (RBTCase a)
forall a. (BinaryTreeNode a, Show a) => Int -> RBTCase a -> ShowS
forall a. (BinaryTreeNode a, Show a) => [RBTCase a] -> ShowS
forall a. (BinaryTreeNode a, Show a) => RBTCase a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. (BinaryTreeNode a, Show a) => Int -> RBTCase a -> ShowS
showsPrec :: Int -> RBTCase a -> ShowS
$cshow :: forall a. (BinaryTreeNode a, Show a) => RBTCase a -> String
show :: RBTCase a -> String
$cshowList :: forall a. (BinaryTreeNode a, Show a) => [RBTCase a] -> ShowS
showList :: [RBTCase a] -> ShowS
Show)
identifyCases345 :: (BinaryTreeNode a) => RedBlackDirections a ->
RedBlackDirection a -> RedBlackDirection a -> RedBlackBranch a -> RBTCase a
identifyCases345 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackDirection a
-> RedBlackBranch a
-> RBTCase a
identifyCases345 RedBlackDirections a
directions
(TreeDirection BranchType
grandparentBranchType RedBlackNode a
grandparentNode
(Branch BinaryTree (RedBlackNode a)
leftCousin (RedBlackNode RedBlack
Red a
uncleContent) BinaryTree (RedBlackNode a)
rightCousin))
TreeDirection (RedBlackNode a)
parentDirection RedBlackBranch a
newBranch =
case BranchType
grandparentBranchType of
BranchType
LeftBranch ->
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
forall a.
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
Case3 RedBlackDirections a
directions a
grandparentContent WhiteBranch a
whiteParent WhiteBranch a
whiteUncle
BranchType
RightBranch ->
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
forall a.
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RBTCase a
Case3 RedBlackDirections a
directions a
grandparentContent WhiteBranch a
whiteUncle WhiteBranch a
whiteParent
where uncleNode :: RedBlackNode a
uncleNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
uncleContent
uncleBranch :: RedBlackBranch a
uncleBranch = BinaryTree (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree (RedBlackNode a)
leftCousin RedBlackNode a
uncleNode BinaryTree (RedBlackNode a)
rightCousin
parentBranch :: RedBlackBranch a
parentBranch = RedBlackBranch a
-> TreeDirection (RedBlackNode a) -> RedBlackBranch a
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor RedBlackBranch a
newBranch TreeDirection (RedBlackNode a)
parentDirection
grandparentDirection :: TreeDirection (RedBlackNode a)
grandparentDirection = BranchType
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> TreeDirection (RedBlackNode a)
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
grandparentBranchType
RedBlackNode a
grandparentNode (BinaryTree (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> BinaryTree (RedBlackNode a)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree (RedBlackNode a)
leftCousin RedBlackNode a
uncleNode BinaryTree (RedBlackNode a)
rightCousin)
RedBlackNode RedBlack
_ a
grandparentContent = RedBlackNode a
grandparentNode
whiteUncle :: WhiteBranch a
whiteUncle = RedBlackBranch a -> WhiteBranch a
forall a. BinaryTreeNode a => RedBlackBranch a -> WhiteBranch a
removeBranchColor RedBlackBranch a
uncleBranch
whiteParent :: WhiteBranch a
whiteParent = RedBlackBranch a -> WhiteBranch a
forall a. BinaryTreeNode a => RedBlackBranch a -> WhiteBranch a
removeBranchColor RedBlackBranch a
parentBranch
identifyCases345 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection TreeDirection (RedBlackNode a)
parentDirection RedBlackBranch a
newBranch
| BranchType
grandparentBranchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
/= BranchType
parentBranchType =
RedBlackDirections a
-> TreeDirection (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> RedBlackBranch a
-> RBTCase a
forall a.
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
Case4 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection RedBlackNode a
parentNode BinaryTree (RedBlackNode a)
siblingTree RedBlackBranch a
newBranch
| BranchType
grandparentBranchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
parentBranchType =
RedBlackDirections a
-> TreeDirection (RedBlackNode a)
-> a
-> BinaryTree (RedBlackNode a)
-> RedBlackBranch a
-> RBTCase a
forall a.
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
Case5 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection a
parentContent BinaryTree (RedBlackNode a)
siblingTree RedBlackBranch a
newBranch
where TreeDirection BranchType
grandparentBranchType RedBlackNode a
_ BinaryTree (RedBlackNode a)
_ = TreeDirection (RedBlackNode a)
grandparentDirection
TreeDirection BranchType
parentBranchType RedBlackNode a
parentNode BinaryTree (RedBlackNode a)
siblingTree = TreeDirection (RedBlackNode a)
parentDirection
RedBlackNode RedBlack
_ a
parentContent = RedBlackNode a
parentNode
identifyRBTCase :: (BinaryTreeNode a) => TreeFamily (RedBlackNode a) ->
RBTCase a
identifyRBTCase :: forall a.
BinaryTreeNode a =>
TreeFamily (RedBlackNode a) -> RBTCase a
identifyRBTCase (IsRoot TreeBranch (RedBlackNode a)
rootBranch) = WhiteBranch a -> RBTCase a
forall a. WhiteBranch a -> RBTCase a
Case1 (TreeBranch (RedBlackNode a) -> WhiteBranch a
forall a. BinaryTreeNode a => RedBlackBranch a -> WhiteBranch a
removeBranchColor TreeBranch (RedBlackNode a)
rootBranch)
identifyRBTCase (HasParent TreeDirection (RedBlackNode a)
direction TreeBranch (RedBlackNode a)
insertedBranch) = RedBlackDirections a -> TreeBranch (RedBlackNode a) -> RBTCase a
forall a. RedBlackDirections a -> RedBlackBranch a -> RBTCase a
Case2 [] TreeBranch (RedBlackNode a)
parentBranch
where parentBranch :: TreeBranch (RedBlackNode a)
parentBranch = TreeBranch (RedBlackNode a)
-> TreeDirection (RedBlackNode a) -> TreeBranch (RedBlackNode a)
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch (RedBlackNode a)
insertedBranch TreeDirection (RedBlackNode a)
direction
identifyRBTCase (HasGrandparent RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection
TreeDirection (RedBlackNode a)
parentDirection TreeBranch (RedBlackNode a)
insertedBranch) =
if TreeBranch (RedBlackNode a)
parentBranch TreeBranch (RedBlackNode a) -> RedBlack -> Bool
forall a.
BinaryTreeNode a =>
TreeBranch (RedBlackNode a) -> RedBlack -> Bool
`branchIsColor` RedBlack
Black
then RedBlackDirections a -> TreeBranch (RedBlackNode a) -> RBTCase a
forall a. RedBlackDirections a -> RedBlackBranch a -> RBTCase a
Case2 (TreeDirection (RedBlackNode a)
grandparentDirectionTreeDirection (RedBlackNode a)
-> RedBlackDirections a -> RedBlackDirections a
forall a. a -> [a] -> [a]
:RedBlackDirections a
directions) TreeBranch (RedBlackNode a)
parentBranch
else RedBlackDirections a
-> TreeDirection (RedBlackNode a)
-> TreeDirection (RedBlackNode a)
-> TreeBranch (RedBlackNode a)
-> RBTCase a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackDirection a
-> RedBlackBranch a
-> RBTCase a
identifyCases345 RedBlackDirections a
directions TreeDirection (RedBlackNode a)
grandparentDirection TreeDirection (RedBlackNode a)
parentDirection
TreeBranch (RedBlackNode a)
insertedBranch
where parentBranch :: TreeBranch (RedBlackNode a)
parentBranch = TreeBranch (RedBlackNode a)
-> TreeDirection (RedBlackNode a) -> TreeBranch (RedBlackNode a)
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch (RedBlackNode a)
insertedBranch TreeDirection (RedBlackNode a)
parentDirection
grandparentBranch :: TreeBranch (RedBlackNode a)
grandparentBranch = TreeBranch (RedBlackNode a)
-> TreeDirection (RedBlackNode a) -> TreeBranch (RedBlackNode a)
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch (RedBlackNode a)
parentBranch
TreeDirection (RedBlackNode a)
grandparentDirection
TreeDirection BranchType
_ RedBlackNode a
_ BinaryTree (RedBlackNode a)
uncleTree = TreeDirection (RedBlackNode a)
parentDirection
TreeBranch BinaryTree (RedBlackNode a)
_ RedBlackNode a
parentContent BinaryTree (RedBlackNode a)
_ = TreeBranch (RedBlackNode a)
parentBranch
TreeBranch BinaryTree (RedBlackNode a)
_ RedBlackNode a
grandparentContent BinaryTree (RedBlackNode a)
_ = TreeBranch (RedBlackNode a)
grandparentBranch
handleRBTCase1 :: (BinaryTreeNode a) => WhiteBranch a -> RedBlackTree a
handleRBTCase1 :: forall a. BinaryTreeNode a => WhiteBranch a -> RedBlackTree a
handleRBTCase1 WhiteBranch a
whiteRoot = BinaryTree (RedBlackNode a)
-> RedBlackNode a
-> BinaryTree (RedBlackNode a)
-> BinaryTree (RedBlackNode a)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree (RedBlackNode a)
leftChild RedBlackNode a
rootNode BinaryTree (RedBlackNode a)
rightChild
where WhiteBranch BinaryTree (RedBlackNode a)
leftChild a
content BinaryTree (RedBlackNode a)
rightChild = WhiteBranch a
whiteRoot
rootNode :: RedBlackNode a
rootNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Black a
content
handleRBTCase2 :: (BinaryTreeNode a) => RedBlackDirections a -> RedBlackBranch a
-> RedBlackTree a
handleRBTCase2 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a -> RedBlackBranch a -> RedBlackTree a
handleRBTCase2 RedBlackDirections a
directionsFromRoot RedBlackBranch a
newBranch = RedBlackBranch a -> BinaryTree (RedBlackNode a)
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree RedBlackBranch a
rootBranch
where branchZipper :: (RedBlackBranch a, RedBlackDirections a)
branchZipper = (RedBlackBranch a
newBranch, RedBlackDirections a
directionsFromRoot)
(RedBlackBranch a
rootBranch, RedBlackDirections a
_) = (RedBlackBranch a, RedBlackDirections a)
-> (RedBlackBranch a, RedBlackDirections a)
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (RedBlackBranch a, RedBlackDirections a)
branchZipper
handleRBTCase3 :: (BinaryTreeNode a) => RedBlackDirections a -> a ->
WhiteBranch a -> WhiteBranch a -> RedBlackTree a
handleRBTCase3 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RedBlackTree a
handleRBTCase3 RedBlackDirections a
directionsFromRoot a
grandparentContent WhiteBranch a
leftWBranch WhiteBranch a
rightWBranch =
(RBTCase a -> RedBlackTree a
forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (RBTCase a -> RedBlackTree a)
-> (BranchZipper (RedBlackNode a) -> RBTCase a)
-> BranchZipper (RedBlackNode a)
-> RedBlackTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFamily (RedBlackNode a) -> RBTCase a
forall a.
BinaryTreeNode a =>
TreeFamily (RedBlackNode a) -> RBTCase a
identifyRBTCase (TreeFamily (RedBlackNode a) -> RBTCase a)
-> (BranchZipper (RedBlackNode a) -> TreeFamily (RedBlackNode a))
-> BranchZipper (RedBlackNode a)
-> RBTCase a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchZipper (RedBlackNode a) -> TreeFamily (RedBlackNode a)
forall a. BinaryTreeNode a => BranchZipper a -> TreeFamily a
getTreeFamily) BranchZipper (RedBlackNode a)
repaintedGrandparentZipper
where newLeftChild :: RedBlackTree a
newLeftChild = WhiteBranch a -> RedBlack -> RedBlackTree a
forall a.
BinaryTreeNode a =>
WhiteBranch a -> RedBlack -> RedBlackTree a
whiteBranch2Tree WhiteBranch a
leftWBranch RedBlack
Black
newRightChild :: RedBlackTree a
newRightChild = WhiteBranch a -> RedBlack -> RedBlackTree a
forall a.
BinaryTreeNode a =>
WhiteBranch a -> RedBlack -> RedBlackTree a
whiteBranch2Tree WhiteBranch a
rightWBranch RedBlack
Black
newNode :: RedBlackNode a
newNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
grandparentContent
newBranch :: TreeBranch (RedBlackNode a)
newBranch = RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> TreeBranch (RedBlackNode a)
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
newLeftChild RedBlackNode a
newNode RedBlackTree a
newRightChild
repaintedGrandparentZipper :: BranchZipper (RedBlackNode a)
repaintedGrandparentZipper = (TreeBranch (RedBlackNode a)
newBranch, RedBlackDirections a
directionsFromRoot)
handleRBTCase4 :: (BinaryTreeNode a) =>
RedBlackDirections a ->
RedBlackDirection a ->
RedBlackNode a ->
RedBlackTree a ->
RedBlackBranch a ->
RedBlackTree a
handleRBTCase4 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase4 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection RedBlackNode a
parentNode RedBlackTree a
siblingTree
RedBlackBranch a
latestBranch =
RBTCase a -> RedBlackTree a
forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
forall a.
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RBTCase a
Case5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
newParentContent
RedBlackTree a
newSiblingTree RedBlackBranch a
newLatestBranch)
where TreeBranch RedBlackTree a
latestLeftTree (RedBlackNode RedBlack
_ a
childContent)
RedBlackTree a
latestRightTree = RedBlackBranch a
latestBranch
TreeDirection BranchType
grandparentDirectionType RedBlackNode a
_ RedBlackTree a
_ = RedBlackDirection a
grandparentDirection
newParentContent :: a
newParentContent = a
childContent
newLatestNode :: RedBlackNode a
newLatestNode = RedBlackNode a
parentNode
newLatestBranch :: RedBlackBranch a
newLatestBranch = if BranchType
grandparentDirectionType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch then
RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
siblingTree RedBlackNode a
newLatestNode RedBlackTree a
latestLeftTree else
RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
latestRightTree RedBlackNode a
newLatestNode RedBlackTree a
siblingTree
newSiblingTree :: RedBlackTree a
newSiblingTree = if BranchType
grandparentDirectionType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch then
RedBlackTree a
latestRightTree else RedBlackTree a
latestLeftTree
handleRBTCase5 :: (BinaryTreeNode a) =>
RedBlackDirections a ->
RedBlackDirection a ->
a ->
RedBlackTree a ->
RedBlackBranch a ->
RedBlackTree a
handleRBTCase5 :: forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
parentContent
RedBlackTree a
siblingTree RedBlackBranch a
latestBranch =
RedBlackBranch a -> RedBlackTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree RedBlackBranch a
postRotationRootBranch
where TreeDirection BranchType
grandparentDirectionType RedBlackNode a
grandparentNode RedBlackTree a
uncleTree =
RedBlackDirection a
grandparentDirection
RedBlackNode RedBlack
_ a
grandparentContent = RedBlackNode a
grandparentNode
newTopNode :: RedBlackNode a
newTopNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Black a
parentContent
rotatedGrandparentNode :: RedBlackNode a
rotatedGrandparentNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
grandparentContent
latestTree :: RedBlackTree a
latestTree = RedBlackBranch a -> RedBlackTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree RedBlackBranch a
latestBranch
needsRightRotation :: Bool
needsRightRotation = BranchType
grandparentDirectionType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch
newSiblingTree :: RedBlackTree a
newSiblingTree = if Bool
needsRightRotation
then RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch RedBlackTree a
siblingTree RedBlackNode a
rotatedGrandparentNode RedBlackTree a
uncleTree
else RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch RedBlackTree a
uncleTree RedBlackNode a
rotatedGrandparentNode RedBlackTree a
siblingTree
rotatedBranch :: RedBlackBranch a
rotatedBranch = if Bool
needsRightRotation
then RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
latestTree RedBlackNode a
newTopNode RedBlackTree a
newSiblingTree
else RedBlackTree a
-> RedBlackNode a -> RedBlackTree a -> RedBlackBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch RedBlackTree a
newSiblingTree RedBlackNode a
newTopNode RedBlackTree a
latestTree
rotatedBranchZipper :: (RedBlackBranch a, RedBlackDirections a)
rotatedBranchZipper = (RedBlackBranch a
rotatedBranch, RedBlackDirections a
directions)
(RedBlackBranch a
postRotationRootBranch, RedBlackDirections a
_) = (RedBlackBranch a, RedBlackDirections a)
-> (RedBlackBranch a, RedBlackDirections a)
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (RedBlackBranch a, RedBlackDirections a)
rotatedBranchZipper
handleRBTCase :: (BinaryTreeNode a) => RBTCase a -> RedBlackTree a
handleRBTCase :: forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (Case1 WhiteBranch a
whiteRoot) = WhiteBranch a -> RedBlackTree a
forall a. BinaryTreeNode a => WhiteBranch a -> RedBlackTree a
handleRBTCase1 WhiteBranch a
whiteRoot
handleRBTCase (Case2 RedBlackDirections a
directionsFromRoot RedBlackBranch a
newBranch) =
RedBlackDirections a -> RedBlackBranch a -> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a -> RedBlackBranch a -> RedBlackTree a
handleRBTCase2 RedBlackDirections a
directionsFromRoot RedBlackBranch a
newBranch
handleRBTCase (Case3 RedBlackDirections a
directionsFromRoot a
content WhiteBranch a
leftWBranch WhiteBranch a
rightWBranch) =
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> a -> WhiteBranch a -> WhiteBranch a -> RedBlackTree a
handleRBTCase3 RedBlackDirections a
directionsFromRoot a
content WhiteBranch a
leftWBranch WhiteBranch a
rightWBranch
handleRBTCase (Case4 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection RedBlackNode a
parentNode RedBlackTree a
siblingTree
RedBlackBranch a
latestBranch) =
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> RedBlackNode a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase4 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection RedBlackNode a
parentNode RedBlackTree a
siblingTree
RedBlackBranch a
latestBranch
handleRBTCase (Case5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
parentContent
RedBlackTree a
siblingTree RedBlackBranch a
latestBranch) =
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
forall a.
BinaryTreeNode a =>
RedBlackDirections a
-> RedBlackDirection a
-> a
-> RedBlackTree a
-> RedBlackBranch a
-> RedBlackTree a
handleRBTCase5 RedBlackDirections a
directions RedBlackDirection a
grandparentDirection a
parentContent
RedBlackTree a
siblingTree RedBlackBranch a
latestBranch
insert :: (BinaryTreeNode a) => RedBlackTree a -> a -> RedBlackTree a
insert :: forall a. BinaryTreeNode a => RedBlackTree a -> a -> RedBlackTree a
insert RedBlackTree a
tree a
newItem = if RedBlackNode a
insertedNode RedBlackNode a -> RedBlack -> Bool
forall a. BinaryTreeNode a => RedBlackNode a -> RedBlack -> Bool
`isColor` RedBlack
Black
then RedBlackTree a
newTreeWithNewItem
else (RBTCase a -> RedBlackTree a
forall a. BinaryTreeNode a => RBTCase a -> RedBlackTree a
handleRBTCase (RBTCase a -> RedBlackTree a)
-> (TreeFamily (RedBlackNode a) -> RBTCase a)
-> TreeFamily (RedBlackNode a)
-> RedBlackTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFamily (RedBlackNode a) -> RBTCase a
forall a.
BinaryTreeNode a =>
TreeFamily (RedBlackNode a) -> RBTCase a
identifyRBTCase) TreeFamily (RedBlackNode a)
insertedTreeFamily
where newNode :: RedBlackNode a
newNode = RedBlack -> a -> RedBlackNode a
forall a. RedBlack -> a -> RedBlackNode a
RedBlackNode RedBlack
Red a
newItem
(TreeBranch (RedBlackNode a)
insertedTreeBranch, TreeDirections (RedBlackNode a)
directions) = RedBlackTree a
-> RedBlackNode a
-> (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
forall a. BinaryTreeNode a => BinaryTree a -> a -> BranchZipper a
binaryTreeInsert RedBlackTree a
tree RedBlackNode a
newNode
TreeBranch RedBlackTree a
_ RedBlackNode a
insertedNode RedBlackTree a
_ = TreeBranch (RedBlackNode a)
insertedTreeBranch
insertedBranchZipper :: (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
insertedBranchZipper = (TreeBranch (RedBlackNode a)
insertedTreeBranch, TreeDirections (RedBlackNode a)
directions)
(TreeBranch (RedBlackNode a)
rootBranch, TreeDirections (RedBlackNode a)
_) = (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
-> (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
insertedBranchZipper
newTreeWithNewItem :: RedBlackTree a
newTreeWithNewItem = TreeBranch (RedBlackNode a) -> RedBlackTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree TreeBranch (RedBlackNode a)
rootBranch
insertedTreeFamily :: TreeFamily (RedBlackNode a)
insertedTreeFamily = (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
-> TreeFamily (RedBlackNode a)
forall a. BinaryTreeNode a => BranchZipper a -> TreeFamily a
getTreeFamily (TreeBranch (RedBlackNode a), TreeDirections (RedBlackNode a))
insertedBranchZipper