#lang racket
;;See http://programmingpraxis.com/ for details.
;;See also http://codepad.org/GKK9n6Td for more general method.
;;To Find the Least Common Ancestor of two given nodes m and n
;;of a binary tree .
;;We first number the nodes , and then use "Remco Niemeijer"
;;code to find the lca.
(define-struct binary-tree (root left right) #:transparent)
(define nodes-num (make-hash))
;traverse a tree in-order and number each node.
(define (number-the-nodes tree)
(define num -1)
(define (number tree)
(cond
[(empty? tree) (void)]
[else (begin
(number (binary-tree-left tree))
(set! num (+ num 1))
(hash-set! nodes-num (binary-tree-root tree) num)
(number (binary-tree-right tree)))]))
(number tree))
;;defines a less-than relation on nodes
(define (less? a b)
(let ([a-num (hash-ref nodes-num a)]
[b-num (hash-ref nodes-num b)])
(< a-num b-num)))
;;defines a greater-than relation on nodes
(define (great? a b)
(let ([a-num (hash-ref nodes-num a)]
[b-num (hash-ref nodes-num b)])
(> a-num b-num)))
;;Finds the lca of two given nodes
(define (least-common-ancestor m n tree)
;;copied shamelessly from "Remco Niemeijer" first post.
(define (lca m n tree)
(let ([root (binary-tree-root tree)]
[left (binary-tree-left tree)]
[right (binary-tree-right tree)])
(cond
[(less? n root) (lca m n left)]
[(great? m root) (lca m n right)]
[else root])))
(cond
[(less? m n) (lca m n tree)]
[(great? m n) (lca n m tree)]
[else m]))
;;encoded binary tree
(define btree
(make-binary-tree
8
(make-binary-tree
3
(make-binary-tree 1 empty empty)
(make-binary-tree
6
(make-binary-tree 4 empty empty)
(make-binary-tree 7 empty empty)))
(make-binary-tree
10
empty
(make-binary-tree
14
(make-binary-tree
13
empty
empty)
empty))))
(number-the-nodes btree)
;;runs
(least-common-ancestor 4 7 btree)
(least-common-ancestor 4 10 btree)
(least-common-ancestor 1 4 btree)
(least-common-ancestor 1 3 btree)
(least-common-ancestor 3 6 btree)