Commit 9ed327d2 authored by Doug Swain's avatar Doug Swain Committed by Doug Swain
Browse files

Implementation of the AVL Balanced BST.

parent 6545813f
module AVL
open Node
open Order
let rec height tree =
match tree with
| Leaf -> 0
| TreeNode (_, l, r) -> 1 + max (height l) (height r)
let rotateLeft node =
let (rootValue, rootLeft, rootRight) = node
match rootRight with
| Leaf -> node
| TreeNode (rValue, rLeft, rRight) ->
(rValue, TreeNode (rootValue, rootLeft, rLeft), rRight)
let rotateRight node =
let (rootValue, rootLeft, rootRight) = node
match rootLeft with
| Leaf -> node
| TreeNode (lValue, lLeft, lRight) ->
(lValue, lLeft, TreeNode (rootValue, lRight, rootRight))
let rec rightRotationStrategy node =
let (rootValue, rootLeft, rootRight) = node
match rootLeft with
| Leaf -> node
| TreeNode (leftValue, lLeftSubtree, lRightSubtree) ->
if (height lLeftSubtree) - (height lRightSubtree) > 0 then
rotateRight node
else
rotateRight (rootValue, TreeNode (rotateLeft (leftValue, lLeftSubtree, lRightSubtree)), rootRight)
let rec leftRotationStrategy node =
let (rootValue, rootLeft, rootRight) = node
match rootRight with
| Leaf -> node
| TreeNode (rightValue, rLeftSubtree, rRightSubtree) ->
if (height rLeftSubtree) - (height rRightSubtree) < 0 then
rotateLeft node
else
rotateLeft (rootValue, rootLeft, TreeNode (rotateRight (rightValue, rLeftSubtree, rRightSubtree)))
let rec add value tree =
match tree with
| Leaf -> TreeNode(value, Leaf, Leaf)
| TreeNode (v, left, right) as node ->
let nextTree =
if value < v then TreeNode (v, add value left, right)
elif value > v then TreeNode (v, left, add value right)
else node
match nextTree with
| Leaf -> nextTree
| TreeNode (v, l, r) ->
let heightDiff = (height l) - (height r)
if heightDiff > 1 then TreeNode (rightRotationStrategy (v, l, r))
elif heightDiff < -1 then TreeNode (leftRotationStrategy (v, l, r))
else nextTree
let create value =
TreeNode (value, Leaf, Leaf)
let rec max tree =
match tree with
| Leaf -> None
| TreeNode (v, _, Leaf) -> Some v
| TreeNode (_, _, right) -> max right
let rec min tree =
match tree with
| Leaf -> None
| TreeNode (v, Leaf, _) -> Some v
| TreeNode (_, left, _) -> min left
let rec printInfix tree =
match tree with
| TreeNode (value, left, right) -> printInfix left; printf "%A" value; printInfix right;
| Leaf -> ()
let rec printPostfix tree =
match tree with
| TreeNode (value, left, right) -> printInfix left; printInfix right; printf "%A" value;
| Leaf -> ()
let rec printPrefix tree =
match tree with
| TreeNode (value, left, right) -> printf "%A" value; printInfix left; printInfix right;
| Leaf -> ()
let print tree order =
match order with
| INFIX -> printInfix tree
| POSTFIX -> printPostfix tree
| PREFIX -> printPrefix tree
let rec search value tree =
match tree with
| Leaf -> None
| TreeNode (v, left, right) ->
if value = v then Some v
elif value < v then search value left
else search value right
let rec remove value tree =
match tree with
| Leaf -> tree
| TreeNode (v, left, right) ->
let nextTree =
if value < v then TreeNode (v, remove value left, right)
elif value > v then TreeNode (v, left, remove value right)
else
match (left, right) with
| (TreeNode (_), TreeNode (_)) as children ->
let tLeft, tRight = children
match min tRight with
| None -> tree
| Some successor -> TreeNode (successor, tLeft, remove successor tRight)
| (Leaf, Leaf) -> Leaf
| (t, Leaf) | (Leaf, t) -> t
match nextTree with
| Leaf -> nextTree
| TreeNode (v, l, r) ->
let heightDiff = (height l) - (height r)
if heightDiff > 1 then TreeNode (rightRotationStrategy (v, l, r))
elif heightDiff < -1 then TreeNode (leftRotationStrategy (v, l, r))
else nextTree
\ No newline at end of file
......@@ -69,4 +69,4 @@ let rec remove value tree =
| None -> tree
| Some successor -> TreeNode (successor, tLeft, remove successor tRight)
| (Leaf, Leaf) -> Leaf
| (t, _) | (_, t) -> t
\ No newline at end of file
| (t, Leaf) | (Leaf, t) -> t
\ No newline at end of file
module Trees.AVL.Tests
open Expecto
open AVL
open Node
let extractTreeNode node =
match node with
| TreeNode (v, l, r) -> (v, l, r)
| _ -> failwith "Invalid Node type" "Only TreeNode (T * TreeNode * TreeNode) are supported"
[<Tests>]
let tests =
testList "AVL Tree" [
testList "Add" [
test "Added value can be found" {
let tree = create "B" |> add "A" |> add "C" |> add "D"
let result = search "D" tree
Expect.isSome result "No result found for search 'D'"
}
test "Remains balanced after initial addition" {
let tree = create "B" |> add "A"
let nextTree = add "C" tree
let (_, l, r) = extractTreeNode nextTree
Expect.equal (height tree) (height nextTree) "Old tree and new tree should have same height"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced far left (AKA LL, AKA Single Left Rotation)" {
let tree = create "A" |> add "B"
let nextTree = add "C" tree
let (_, l, r) = extractTreeNode nextTree
Expect.equal (height tree) (height nextTree) "Old tree and new tree should have same height"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced somewhat left (AKA LR, AKA Double Left Rotation)" {
let tree = create "A" |> add "C"
let nextTree = add "B" tree
let (_, l, r) = extractTreeNode nextTree
Expect.equal (height tree) (height nextTree) "Old tree and new tree should have same height"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced far right (AKA RR, AKA Single Right Rotation)" {
let tree = create "C" |> add "B"
let nextTree = add "A" tree
let (_, l, r) = extractTreeNode nextTree
Expect.equal (height tree) (height nextTree) "Old tree and new tree should have same height"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced somewhat right (AKA RL, AKA Double Right Rotation)" {
let tree = create "C" |> add "A"
let nextTree = add "B" tree
let (_, l, r) = extractTreeNode nextTree
Expect.equal (height tree) (height nextTree) "Old tree and new tree should have same height"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Larger trees will be maintain the height invariant" {
let tree = create "C" |> add "A" |> add "B" |> add "F" |> add "E"
let nextTree = add "D" tree
let (_, firstLeft, firstRight) = extractTreeNode tree
let (_, nextLeft, nextRight) = extractTreeNode nextTree
Expect.equal (height firstLeft) 1 "The left subtree is the wrong height after 'E' was added"
Expect.equal (height firstRight) 2 "The right subtree is the wrong height after 'E' was added"
Expect.equal (height nextLeft) 2 "The left subtree is the wrong height after 'D' was added"
Expect.equal (height nextRight) 2 "The right subtree is the wrong height after 'D' was added"
}
]
testList "Height" [
test "Single node (1) tree has a height of 1" {
let node = create "Test Value"
Expect.equal (AVL.height node) 1 "Single node has height zero"
}
test "Multi node (3) tree | one (1) right of the root and one (1) left of the root)" {
let node = create "B" |> add "C" |> add "A"
Expect.equal (AVL.height node) 2 "Equal subtree heights should be 2"
}
test "Multi node (5) tree | three (3) left of the root and one (1) right of the root" {
let node = create "D" |> add "B" |> add "C" |> add "A" |> add "E"
Expect.equal (AVL.height node) 3 "Multi-node height should be 3"
}
test "Multi node (3) tree | three (3) right of the root and one (1) left of the root" {
let node = create "B" |> add "A" |> add "D" |> add "C" |> add "E"
Expect.equal (AVL.height node) 3 "Multi-node height should be 3"
}
]
testList "Remove" [
test "Value cannot be found after removal" {
let tree = create "B" |> add "A" |> add "C"
let nextTree = remove "C" tree
Expect.isNone (search "C" nextTree) "Value found after attempting to remove 'C'"
}
test "Remains balanced after initial removal" {
let tree = create "B" |> add "A" |> add "C"
let nextTree = remove "C" tree
let (_, l, r) = extractTreeNode nextTree
Expect.equal (height tree) (height nextTree) "Old tree and new tree should have same height"
Expect.isGreaterThan (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced far left (AKA LL, AKA Single Left Rotation)" {
let tree = create "A" |> add "B" |> add "C" |> add "D"
let nextTree = remove "A" tree
let (_, l, r) = extractTreeNode nextTree
Expect.isGreaterThan (height tree) (height nextTree) "Height of old tree <= Height of next tree"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced somewhat left (AKA LR, AKA Double Left Rotation)" {
let tree = create "B" |> add "A" |> add "D" |> add "C"
let nextTree = remove "A" tree
let (_, l, r) = extractTreeNode nextTree
Expect.isGreaterThan (height tree) (height nextTree) "Height of old tree <= Height of next tree"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced far right (AKA RR, AKA Single Right Rotation)" {
let tree = create "C" |> add "D" |> add "B" |> add "A"
let nextTree = remove "D" tree
let (_, l, r) = extractTreeNode nextTree
Expect.isGreaterThan (height tree) (height nextTree) "Height of old tree <= Height of next tree"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Becomes unbalanced somewhat right (AKA RL, AKA Double Right Rotation)" {
let tree = create "C" |> add "D" |> add "A" |> add "B"
let nextTree = remove "D" tree
let (_, l, r) = extractTreeNode nextTree
Expect.isGreaterThan (height tree) (height nextTree) "Height of old tree <= Height of next tree"
Expect.equal (height l) (height r) "Balanced tree should have equal height"
}
test "Larger trees will be maintain the height invariant" {
let tree = create "C" |> add "A" |> add "E" |> add "B" |> add "D" |> add "F" |> add "H"
let nextTree = remove "A" tree
let (_, firstLeft, firstRight) = extractTreeNode tree
let (_, nextLeft, nextRight) = extractTreeNode nextTree
Expect.equal (height firstLeft) 2 "The left subtree is the wrong height after 'H' was added"
Expect.equal (height firstRight) 3 "The right subtree is the wrong height after 'H' was added"
Expect.equal (height nextLeft) 2 "The left subtree is the wrong height after 'A' was removed"
Expect.equal (height nextRight) 2 "The right subtree is the wrong height after 'A' was removed"
}
]
]
\ No newline at end of file
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5" />
</startup>
</configuration>
\ No newline at end of file
module Trees.Tests
open Expecto
[<EntryPoint>]
let main args =
runTestsInAssembly defaultConfig args
\ No newline at end of file
This diff is collapsed.
FSharp.Core
Expecto
Argu
\ No newline at end of file
source https://www.nuget.org/api/v2
nuget Argu
nuget Expecto
nuget FAKE
nuget FSharp.Core
\ No newline at end of file
This diff is collapsed.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment