module Data.RedBlackTree.BinaryTree (
BinaryTreeNode (mergeNodes),
BinaryTree (Leaf, Branch),
BranchType (LeftBranch, RightBranch),
BranchZipper,
TreeBranch (TreeBranch),
TreeDirection (TreeDirection),
TreeDirections,
TreeInsertResult (InsertOk, InsertNotYet, InsertMerge),
TreeZipper,
appendLeftChild,
appendRightChild,
binaryTreeInsert,
binaryTreeFind,
branch2Tree,
branchZipperInsert,
getTreeRoot,
goLeft,
goUp,
goRight,
reconstructAncestor
) where
import Data.Maybe
class (Ord a) => BinaryTreeNode a where
mergeNodes :: a -> a -> a
data BinaryTree a = Leaf | Branch (BinaryTree a) a (BinaryTree a)
deriving (BinaryTree a -> BinaryTree a -> Bool
(BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool) -> Eq (BinaryTree a)
forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
== :: BinaryTree a -> BinaryTree a -> Bool
$c/= :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
/= :: BinaryTree a -> BinaryTree a -> Bool
Eq, Eq (BinaryTree a)
Eq (BinaryTree a) =>
(BinaryTree a -> BinaryTree a -> Ordering)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> Ord (BinaryTree a)
BinaryTree a -> BinaryTree a -> Bool
BinaryTree a -> BinaryTree a -> Ordering
BinaryTree a -> BinaryTree a -> BinaryTree 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. Ord a => Eq (BinaryTree a)
forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
$ccompare :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
compare :: BinaryTree a -> BinaryTree a -> Ordering
$c< :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
< :: BinaryTree a -> BinaryTree a -> Bool
$c<= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
<= :: BinaryTree a -> BinaryTree a -> Bool
$c> :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
> :: BinaryTree a -> BinaryTree a -> Bool
$c>= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
>= :: BinaryTree a -> BinaryTree a -> Bool
$cmax :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
max :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmin :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
min :: BinaryTree a -> BinaryTree a -> BinaryTree a
Ord)
instance (BinaryTreeNode a, Show a) => Show (BinaryTree a) where
show :: BinaryTree a -> String
show BinaryTree a
tree = BinaryTree a -> Int -> String
forall {a}. Show a => BinaryTree a -> Int -> String
prettyPrintTree BinaryTree a
tree Int
0
where
addSpaces :: Int -> String
addSpaces Int
num = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
num Char
' '
prettyPrintTree :: BinaryTree a -> Int -> String
prettyPrintTree BinaryTree a
Leaf Int
spaces = String
" Leaf"
prettyPrintTree (Branch BinaryTree a
leftTree a
content BinaryTree a
rightTree) Int
spaces =
String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
content String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
identation String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"L:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinaryTree a -> String
prettyPrintSubtree BinaryTree a
leftTree String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
identation String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"R:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BinaryTree a -> String
prettyPrintSubtree BinaryTree a
rightTree
where identation :: String
identation = Int -> String
addSpaces (Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
prettyPrintSubtree :: BinaryTree a -> String
prettyPrintSubtree BinaryTree a
subtree = BinaryTree a -> Int -> String
prettyPrintTree BinaryTree a
subtree (Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
data BranchType = LeftBranch | RightBranch deriving (Int -> BranchType -> ShowS
[BranchType] -> ShowS
BranchType -> String
(Int -> BranchType -> ShowS)
-> (BranchType -> String)
-> ([BranchType] -> ShowS)
-> Show BranchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchType -> ShowS
showsPrec :: Int -> BranchType -> ShowS
$cshow :: BranchType -> String
show :: BranchType -> String
$cshowList :: [BranchType] -> ShowS
showList :: [BranchType] -> ShowS
Show, BranchType -> BranchType -> Bool
(BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool) -> Eq BranchType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchType -> BranchType -> Bool
== :: BranchType -> BranchType -> Bool
$c/= :: BranchType -> BranchType -> Bool
/= :: BranchType -> BranchType -> Bool
Eq, Eq BranchType
Eq BranchType =>
(BranchType -> BranchType -> Ordering)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> Bool)
-> (BranchType -> BranchType -> BranchType)
-> (BranchType -> BranchType -> BranchType)
-> Ord BranchType
BranchType -> BranchType -> Bool
BranchType -> BranchType -> Ordering
BranchType -> BranchType -> BranchType
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
$ccompare :: BranchType -> BranchType -> Ordering
compare :: BranchType -> BranchType -> Ordering
$c< :: BranchType -> BranchType -> Bool
< :: BranchType -> BranchType -> Bool
$c<= :: BranchType -> BranchType -> Bool
<= :: BranchType -> BranchType -> Bool
$c> :: BranchType -> BranchType -> Bool
> :: BranchType -> BranchType -> Bool
$c>= :: BranchType -> BranchType -> Bool
>= :: BranchType -> BranchType -> Bool
$cmax :: BranchType -> BranchType -> BranchType
max :: BranchType -> BranchType -> BranchType
$cmin :: BranchType -> BranchType -> BranchType
min :: BranchType -> BranchType -> BranchType
Ord)
data TreeDirection a = TreeDirection BranchType a (BinaryTree a)
deriving (Int -> TreeDirection a -> ShowS
[TreeDirection a] -> ShowS
TreeDirection a -> String
(Int -> TreeDirection a -> ShowS)
-> (TreeDirection a -> String)
-> ([TreeDirection a] -> ShowS)
-> Show (TreeDirection a)
forall a.
(Show a, BinaryTreeNode a) =>
Int -> TreeDirection a -> ShowS
forall a. (Show a, BinaryTreeNode a) => [TreeDirection a] -> ShowS
forall a. (Show a, BinaryTreeNode a) => TreeDirection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a.
(Show a, BinaryTreeNode a) =>
Int -> TreeDirection a -> ShowS
showsPrec :: Int -> TreeDirection a -> ShowS
$cshow :: forall a. (Show a, BinaryTreeNode a) => TreeDirection a -> String
show :: TreeDirection a -> String
$cshowList :: forall a. (Show a, BinaryTreeNode a) => [TreeDirection a] -> ShowS
showList :: [TreeDirection a] -> ShowS
Show, TreeDirection a -> TreeDirection a -> Bool
(TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> Eq (TreeDirection a)
forall a. Eq a => TreeDirection a -> TreeDirection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TreeDirection a -> TreeDirection a -> Bool
== :: TreeDirection a -> TreeDirection a -> Bool
$c/= :: forall a. Eq a => TreeDirection a -> TreeDirection a -> Bool
/= :: TreeDirection a -> TreeDirection a -> Bool
Eq, Eq (TreeDirection a)
Eq (TreeDirection a) =>
(TreeDirection a -> TreeDirection a -> Ordering)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> Bool)
-> (TreeDirection a -> TreeDirection a -> TreeDirection a)
-> (TreeDirection a -> TreeDirection a -> TreeDirection a)
-> Ord (TreeDirection a)
TreeDirection a -> TreeDirection a -> Bool
TreeDirection a -> TreeDirection a -> Ordering
TreeDirection a -> TreeDirection a -> TreeDirection 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. Ord a => Eq (TreeDirection a)
forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
forall a. Ord a => TreeDirection a -> TreeDirection a -> Ordering
forall a.
Ord a =>
TreeDirection a -> TreeDirection a -> TreeDirection a
$ccompare :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Ordering
compare :: TreeDirection a -> TreeDirection a -> Ordering
$c< :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
< :: TreeDirection a -> TreeDirection a -> Bool
$c<= :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
<= :: TreeDirection a -> TreeDirection a -> Bool
$c> :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
> :: TreeDirection a -> TreeDirection a -> Bool
$c>= :: forall a. Ord a => TreeDirection a -> TreeDirection a -> Bool
>= :: TreeDirection a -> TreeDirection a -> Bool
$cmax :: forall a.
Ord a =>
TreeDirection a -> TreeDirection a -> TreeDirection a
max :: TreeDirection a -> TreeDirection a -> TreeDirection a
$cmin :: forall a.
Ord a =>
TreeDirection a -> TreeDirection a -> TreeDirection a
min :: TreeDirection a -> TreeDirection a -> TreeDirection a
Ord)
type TreeDirections a = [TreeDirection a]
type TreeZipper a = (BinaryTree a, TreeDirections a)
data TreeBranch a = TreeBranch (BinaryTree a) a (BinaryTree a)
deriving (TreeBranch a -> TreeBranch a -> Bool
(TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool) -> Eq (TreeBranch a)
forall a. Eq a => TreeBranch a -> TreeBranch a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TreeBranch a -> TreeBranch a -> Bool
== :: TreeBranch a -> TreeBranch a -> Bool
$c/= :: forall a. Eq a => TreeBranch a -> TreeBranch a -> Bool
/= :: TreeBranch a -> TreeBranch a -> Bool
Eq, Eq (TreeBranch a)
Eq (TreeBranch a) =>
(TreeBranch a -> TreeBranch a -> Ordering)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> Bool)
-> (TreeBranch a -> TreeBranch a -> TreeBranch a)
-> (TreeBranch a -> TreeBranch a -> TreeBranch a)
-> Ord (TreeBranch a)
TreeBranch a -> TreeBranch a -> Bool
TreeBranch a -> TreeBranch a -> Ordering
TreeBranch a -> TreeBranch a -> TreeBranch 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. Ord a => Eq (TreeBranch a)
forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
forall a. Ord a => TreeBranch a -> TreeBranch a -> Ordering
forall a. Ord a => TreeBranch a -> TreeBranch a -> TreeBranch a
$ccompare :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Ordering
compare :: TreeBranch a -> TreeBranch a -> Ordering
$c< :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
< :: TreeBranch a -> TreeBranch a -> Bool
$c<= :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
<= :: TreeBranch a -> TreeBranch a -> Bool
$c> :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
> :: TreeBranch a -> TreeBranch a -> Bool
$c>= :: forall a. Ord a => TreeBranch a -> TreeBranch a -> Bool
>= :: TreeBranch a -> TreeBranch a -> Bool
$cmax :: forall a. Ord a => TreeBranch a -> TreeBranch a -> TreeBranch a
max :: TreeBranch a -> TreeBranch a -> TreeBranch a
$cmin :: forall a. Ord a => TreeBranch a -> TreeBranch a -> TreeBranch a
min :: TreeBranch a -> TreeBranch a -> TreeBranch a
Ord)
instance (BinaryTreeNode a, Show a) => Show (TreeBranch a) where
show :: TreeBranch a -> String
show (TreeBranch BinaryTree a
leftChild a
content BinaryTree a
rightChild) =
BinaryTree a -> String
forall a. Show a => a -> String
show (BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree a
leftChild a
content BinaryTree a
rightChild)
type BranchZipper a = (TreeBranch a, TreeDirections a)
data TreeInsertResult a =
InsertOk (TreeBranch a) (TreeDirection a)
| InsertNotYet (BinaryTree a) (TreeDirection a) a
| InsertMerge (TreeBranch a)
deriving (Int -> TreeInsertResult a -> ShowS
[TreeInsertResult a] -> ShowS
TreeInsertResult a -> String
(Int -> TreeInsertResult a -> ShowS)
-> (TreeInsertResult a -> String)
-> ([TreeInsertResult a] -> ShowS)
-> Show (TreeInsertResult a)
forall a.
(BinaryTreeNode a, Show a) =>
Int -> TreeInsertResult a -> ShowS
forall a.
(BinaryTreeNode a, Show a) =>
[TreeInsertResult a] -> ShowS
forall a.
(BinaryTreeNode a, Show a) =>
TreeInsertResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a.
(BinaryTreeNode a, Show a) =>
Int -> TreeInsertResult a -> ShowS
showsPrec :: Int -> TreeInsertResult a -> ShowS
$cshow :: forall a.
(BinaryTreeNode a, Show a) =>
TreeInsertResult a -> String
show :: TreeInsertResult a -> String
$cshowList :: forall a.
(BinaryTreeNode a, Show a) =>
[TreeInsertResult a] -> ShowS
showList :: [TreeInsertResult a] -> ShowS
Show, TreeInsertResult a -> TreeInsertResult a -> Bool
(TreeInsertResult a -> TreeInsertResult a -> Bool)
-> (TreeInsertResult a -> TreeInsertResult a -> Bool)
-> Eq (TreeInsertResult a)
forall a. Eq a => TreeInsertResult a -> TreeInsertResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TreeInsertResult a -> TreeInsertResult a -> Bool
== :: TreeInsertResult a -> TreeInsertResult a -> Bool
$c/= :: forall a. Eq a => TreeInsertResult a -> TreeInsertResult a -> Bool
/= :: TreeInsertResult a -> TreeInsertResult a -> Bool
Eq)
isLeftTreeDirection :: (BinaryTreeNode a) => TreeDirection a -> Bool
isLeftTreeDirection :: forall a. BinaryTreeNode a => TreeDirection a -> Bool
isLeftTreeDirection (TreeDirection BranchType
branchType a
_ BinaryTree a
_) = BranchType
branchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch
getTreeContent :: (BinaryTreeNode a) => BinaryTree a -> Maybe a
getTreeContent :: forall a. BinaryTreeNode a => BinaryTree a -> Maybe a
getTreeContent (Branch BinaryTree a
_ a
content BinaryTree a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
content
getTreeContent BinaryTree a
Leaf = Maybe a
forall a. Maybe a
Nothing
branch2Tree :: (BinaryTreeNode a) => TreeBranch a -> BinaryTree a
branch2Tree :: forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree (TreeBranch BinaryTree a
leftChild a
content BinaryTree a
rightChild) =
BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree a
leftChild a
content BinaryTree a
rightChild
goLeft :: (BinaryTreeNode a) => BranchZipper a -> TreeZipper a
goLeft :: forall a. BinaryTreeNode a => BranchZipper a -> TreeZipper a
goLeft (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) =
(BinaryTree a
leftChild, BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
LeftBranch a
treeNode BinaryTree a
rightChildTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
xs)
goRight :: (BinaryTreeNode a) => BranchZipper a -> TreeZipper a
goRight :: forall a. BinaryTreeNode a => BranchZipper a -> TreeZipper a
goRight (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) =
(BinaryTree a
rightChild, BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
RightBranch a
treeNode BinaryTree a
leftChildTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
xs)
reconstructAncestor :: (BinaryTreeNode a) => TreeBranch a -> TreeDirection a ->
TreeBranch a
reconstructAncestor :: forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch a
currentBranch (TreeDirection BranchType
branchType a
parentContent
BinaryTree a
sibling) =
if BranchType
branchType BranchType -> BranchType -> Bool
forall a. Eq a => a -> a -> Bool
== BranchType
LeftBranch
then BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
currentTree a
parentContent BinaryTree a
sibling
else BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
sibling a
parentContent BinaryTree a
currentTree
where currentTree :: BinaryTree a
currentTree = TreeBranch a -> BinaryTree a
forall a. BinaryTreeNode a => TreeBranch a -> BinaryTree a
branch2Tree TreeBranch a
currentBranch
goUp :: (BinaryTreeNode a) => BranchZipper a -> Maybe (BranchZipper a)
goUp :: forall a.
BinaryTreeNode a =>
BranchZipper a -> Maybe (BranchZipper a)
goUp (TreeBranch a
_, []) = Maybe (TreeBranch a, TreeDirections a)
forall a. Maybe a
Nothing
goUp (TreeBranch a
currentBranch, TreeDirection a
direction:TreeDirections a
xs) =
(TreeBranch a, TreeDirections a)
-> Maybe (TreeBranch a, TreeDirections a)
forall a. a -> Maybe a
Just (TreeBranch a -> TreeDirection a -> TreeBranch a
forall a.
BinaryTreeNode a =>
TreeBranch a -> TreeDirection a -> TreeBranch a
reconstructAncestor TreeBranch a
currentBranch TreeDirection a
direction, TreeDirections a
xs)
getTreeRoot :: (BinaryTreeNode a) => BranchZipper a -> BranchZipper a
getTreeRoot :: forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (TreeBranch a
branch, []) = (TreeBranch a
branch, [])
getTreeRoot (TreeBranch a, TreeDirections a)
zipper = case (TreeBranch a, TreeDirections a)
-> Maybe (TreeBranch a, TreeDirections a)
forall a.
BinaryTreeNode a =>
BranchZipper a -> Maybe (BranchZipper a)
goUp (TreeBranch a, TreeDirections a)
zipper of
Just (TreeBranch a, TreeDirections a)
prevZipper -> (TreeBranch a, TreeDirections a)
-> (TreeBranch a, TreeDirections a)
forall a. BinaryTreeNode a => BranchZipper a -> BranchZipper a
getTreeRoot (TreeBranch a, TreeDirections a)
prevZipper
Maybe (TreeBranch a, TreeDirections a)
Nothing -> (TreeBranch a, TreeDirections a)
zipper
appendLeftChild :: (BinaryTreeNode a) => TreeBranch a -> a -> TreeInsertResult a
appendLeftChild :: forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendLeftChild (TreeBranch BinaryTree a
leftChild a
treeContent BinaryTree a
rightChild) a
nodeToAppend =
if BinaryTree a
leftChild BinaryTree a -> BinaryTree a -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryTree a
forall a. BinaryTree a
Leaf then
TreeBranch a -> TreeDirection a -> TreeInsertResult a
forall a. TreeBranch a -> TreeDirection a -> TreeInsertResult a
InsertOk TreeBranch a
newBranch TreeDirection a
newDirection
else
BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
forall a.
BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
InsertNotYet BinaryTree a
leftChild TreeDirection a
newDirection a
nodeToAppend
where newBranch :: TreeBranch a
newBranch = BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
forall a. BinaryTree a
Leaf a
nodeToAppend BinaryTree a
forall a. BinaryTree a
Leaf
newDirection :: TreeDirection a
newDirection = BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
LeftBranch a
treeContent BinaryTree a
rightChild
appendRightChild :: (BinaryTreeNode a) => TreeBranch a -> a ->
TreeInsertResult a
appendRightChild :: forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendRightChild (TreeBranch BinaryTree a
leftChild a
treeContent BinaryTree a
rightChild) a
nodeToAppend =
if BinaryTree a
rightChild BinaryTree a -> BinaryTree a -> Bool
forall a. Eq a => a -> a -> Bool
== BinaryTree a
forall a. BinaryTree a
Leaf then
TreeBranch a -> TreeDirection a -> TreeInsertResult a
forall a. TreeBranch a -> TreeDirection a -> TreeInsertResult a
InsertOk TreeBranch a
newBranch TreeDirection a
newDirection
else
BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
forall a.
BinaryTree a -> TreeDirection a -> a -> TreeInsertResult a
InsertNotYet BinaryTree a
rightChild TreeDirection a
newDirection a
nodeToAppend
where newBranch :: TreeBranch a
newBranch = BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
forall a. BinaryTree a
Leaf a
nodeToAppend BinaryTree a
forall a. BinaryTree a
Leaf
newDirection :: TreeDirection a
newDirection = BranchType -> a -> BinaryTree a -> TreeDirection a
forall a. BranchType -> a -> BinaryTree a -> TreeDirection a
TreeDirection BranchType
RightBranch a
treeContent BinaryTree a
leftChild
appendWithMerge :: (BinaryTreeNode a) => TreeBranch a -> a ->
TreeInsertResult a
appendWithMerge :: forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendWithMerge (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild) a
nodeToAppend =
TreeBranch a -> TreeInsertResult a
forall a. TreeBranch a -> TreeInsertResult a
InsertMerge (BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
leftChild a
mergedNode BinaryTree a
rightChild)
where mergedNode :: a
mergedNode = a -> a -> a
forall a. BinaryTreeNode a => a -> a -> a
mergeNodes a
treeNode a
nodeToAppend
insertOrGoDown :: (BinaryTreeNode a) => TreeDirections a -> TreeInsertResult a
-> BranchZipper a
insertOrGoDown :: forall a.
BinaryTreeNode a =>
TreeDirections a -> TreeInsertResult a -> BranchZipper a
insertOrGoDown TreeDirections a
treeDirections (InsertMerge TreeBranch a
newBranch) =
(TreeBranch a
newBranch, TreeDirections a
treeDirections)
insertOrGoDown TreeDirections a
treeDirections (InsertOk TreeBranch a
newBranch TreeDirection a
newDirection) =
(TreeBranch a
newBranch, TreeDirection a
newDirectionTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
treeDirections)
insertOrGoDown TreeDirections a
treeDirections (InsertNotYet BinaryTree a
existingChild TreeDirection a
directionToChild
a
childToInsert) =
TreeZipper a -> a -> BranchZipper a
forall a. BinaryTreeNode a => TreeZipper a -> a -> BranchZipper a
treeZipperInsert (BinaryTree a
existingChild, TreeDirection a
directionToChildTreeDirection a -> TreeDirections a -> TreeDirections a
forall a. a -> [a] -> [a]
:TreeDirections a
treeDirections)
a
childToInsert
branchZipperToTreeZipper :: (BinaryTreeNode a) => BranchZipper a -> TreeZipper a
branchZipperToTreeZipper :: forall a. BinaryTreeNode a => BranchZipper a -> TreeZipper a
branchZipperToTreeZipper (TreeBranch BinaryTree a
leftChild a
content BinaryTree a
rightChild, TreeDirections a
xs) =
(BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Branch BinaryTree a
leftChild a
content BinaryTree a
rightChild, TreeDirections a
xs)
branchZipperInsert :: (BinaryTreeNode a) => BranchZipper a -> a ->
BranchZipper a
branchZipperInsert :: forall a. BinaryTreeNode a => BranchZipper a -> a -> BranchZipper a
branchZipperInsert (TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) a
newNode =
TreeDirections a
-> TreeInsertResult a -> (TreeBranch a, TreeDirections a)
forall a.
BinaryTreeNode a =>
TreeDirections a -> TreeInsertResult a -> BranchZipper a
insertOrGoDown TreeDirections a
xs (TreeBranch a -> a -> TreeInsertResult a
appendFunction TreeBranch a
focusedBranch a
newNode)
where
focusedBranch :: TreeBranch a
focusedBranch = BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild
appendFunction :: TreeBranch a -> a -> TreeInsertResult a
appendFunction
| a
newNode a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
treeNode = TreeBranch a -> a -> TreeInsertResult a
forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendLeftChild
| a
newNode a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
treeNode = TreeBranch a -> a -> TreeInsertResult a
forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendRightChild
| Bool
otherwise = TreeBranch a -> a -> TreeInsertResult a
forall a.
BinaryTreeNode a =>
TreeBranch a -> a -> TreeInsertResult a
appendWithMerge
treeZipperInsert :: (BinaryTreeNode a) => TreeZipper a -> a -> BranchZipper a
treeZipperInsert :: forall a. BinaryTreeNode a => TreeZipper a -> a -> BranchZipper a
treeZipperInsert (BinaryTree a
Leaf, TreeDirections a
xs) a
newNode = (BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
forall a. BinaryTree a
Leaf a
newNode BinaryTree a
forall a. BinaryTree a
Leaf, TreeDirections a
xs)
treeZipperInsert (Branch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) a
newNode =
BranchZipper a -> a -> BranchZipper a
forall a. BinaryTreeNode a => BranchZipper a -> a -> BranchZipper a
branchZipperInsert (BinaryTree a -> a -> BinaryTree a -> TreeBranch a
forall a. BinaryTree a -> a -> BinaryTree a -> TreeBranch a
TreeBranch BinaryTree a
leftChild a
treeNode BinaryTree a
rightChild, TreeDirections a
xs) a
newNode
binaryTreeInsert :: (BinaryTreeNode a) => BinaryTree a -> a -> BranchZipper a
binaryTreeInsert :: forall a. BinaryTreeNode a => BinaryTree a -> a -> BranchZipper a
binaryTreeInsert BinaryTree a
tree = TreeZipper a -> a -> BranchZipper a
forall a. BinaryTreeNode a => TreeZipper a -> a -> BranchZipper a
treeZipperInsert TreeZipper a
forall {a}. (BinaryTree a, [a])
treeZipper
where treeZipper :: (BinaryTree a, [a])
treeZipper = (BinaryTree a
tree, [])
binaryTreeFind :: (BinaryTreeNode a) => BinaryTree a -> a -> Maybe a
binaryTreeFind :: forall a. BinaryTreeNode a => BinaryTree a -> a -> Maybe a
binaryTreeFind BinaryTree a
Leaf a
_ = Maybe a
forall a. Maybe a
Nothing
binaryTreeFind (Branch BinaryTree a
leftTree a
content BinaryTree a
rightTree) a
target
| a
target a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
content = a -> Maybe a
forall a. a -> Maybe a
Just a
content
| a
target a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
content = BinaryTree a -> a -> Maybe a
forall a. BinaryTreeNode a => BinaryTree a -> a -> Maybe a
binaryTreeFind BinaryTree a
leftTree a
target
| a
target a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
content = BinaryTree a -> a -> Maybe a
forall a. BinaryTreeNode a => BinaryTree a -> a -> Maybe a
binaryTreeFind BinaryTree a
rightTree a
target