Skip to content

Instantly share code, notes, and snippets.

@munyabe
Created February 9, 2011 09:50
Show Gist options
  • Save munyabe/818223 to your computer and use it in GitHub Desktop.
Save munyabe/818223 to your computer and use it in GitHub Desktop.
module BinaryTreeZipper
type BinaryTree<'value> =
| Node of BinaryTree<'value> * 'value * BinaryTree<'value> // leftChild * value * rightChild
| LeftOnlyNode of BinaryTree<'value> * 'value
| RightOnlyNode of 'value * BinaryTree<'value>
| Leaf of string
type Path<'value> =
| Top
| LeftOfNode of Path<'value> * 'value * BinaryTree<'value> // up * value * rightChild
| LeftOfLeftOnly of Path<'value> * 'value
| RightOfNode of 'value * BinaryTree<'value> * Path<'value> // value * leftChild * up
| RightOfRightOnly of 'value * Path<'value>
type Location<'value> =
| Loc of BinaryTree<'value> * Path<'value>
let getNodeValue (Loc(tree, _)) =
match tree with
| Node(_, value, _)
| LeftOnlyNode(_, value)
| RightOnlyNode(value, _)
| Leaf(value) -> value
let goLeftChild (Loc(tree, path)) =
match tree with
| Node(left, value, right) -> Loc(left, LeftOfNode(path, value, right))
| LeftOnlyNode(left, value) -> Loc(left, LeftOfLeftOnly(path, value))
| _ -> failwith "this node does not have left child"
let goRightChild (Loc(tree, path)) =
match tree with
| Node(left, value, right) -> Loc(right, RightOfNode(value, left, path))
| RightOnlyNode(value, right) -> Loc(right, RightOfRightOnly(value, path))
| _ -> failwith "this node does not have right child"
let goUp (Loc(tree, path)) =
match path with
| Top -> failwith "up of top"
| LeftOfNode(up, value, right) -> Loc(Node(tree, value, right), up)
| LeftOfLeftOnly(up, value) -> Loc(LeftOnlyNode(tree, value), up)
| RightOfNode(value, left, up) -> Loc(Node(left, value, tree), up)
| RightOfRightOnly(value, up) -> Loc(RightOnlyNode(value, tree), up)
let rec goTop (Loc(_, path) as loc) =
match path with
| Top -> loc
| _ -> loc |> goUp |> goTop
let insertLeftChild value (Loc(tree, path)) =
match tree with
| RightOnlyNode(item, right) -> Loc(Node(Leaf(value), item, right), path)
| Leaf(item) -> Loc(LeftOnlyNode(Leaf(value), item), path)
| Node(_) | LeftOnlyNode(_) -> failwith "this node has already left child"
let insertRightChild value (Loc(tree, path)) =
match tree with
| LeftOnlyNode(left, item) -> Loc(Node(left, item, Leaf(value)), path)
| Leaf(item) -> Loc(RightOnlyNode(item, Leaf(value)), path)
| Node(_) | RightOnlyNode(_) -> failwith "this node has already right child"
let updateValue value (Loc(tree, path)) =
match tree with
| Node(left, _, right) -> Loc(Node(left, value, right), path)
| LeftOnlyNode(left, _) -> Loc(LeftOnlyNode(left, value), path)
| RightOnlyNode(_, right) -> Loc(RightOnlyNode(value, right), path)
| Leaf(_) -> Loc(Leaf(value), path)
let hasLeftNode (Loc(tree, _)) =
match tree with
| Node(_) | LeftOnlyNode(_) -> true
| _ -> false
let hasRightNode (Loc(tree, _)) =
match tree with
| Node(_) | RightOnlyNode(_) -> true
| _ -> false
let isLeaf (Loc(tree, _)) =
match tree with
| Leaf(_) -> true
| _ -> false
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment