Check out the Pastebin Gadgets Shop. We have thousands of fun, geeky & affordable gadgets on sale :-)Want more features on Pastebin? Sign Up, it's FREE!
tweet

# LCA for array-based forests

By: a guest on Jun 11th, 2010  |  syntax: Haskell  |  size: 1.88 KB  |  views: 86  |  expires: Never
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
1. module Tree
2. where
3.
4. data Tree = Empty Int
5.           | Pair Int Tree Tree
6.
7. index :: Tree -> Int
8. index (Empty n) = n
9. index (Pair n _ _) = n
10.
11. data Result = HasLeft
12.             | HasRight
13.             | HasBoth Int
14.             | HasNeither
15.
16.
17.
18. join :: Int -> Result -> Result -> Result
19. join _ (HasBoth k) _ = HasBoth k
20. join _ _ (HasBoth k) = HasBoth k
21. join _ HasNeither r = r
22. join _ r HasNeither = r
23. join k HasLeft HasRight = HasBoth k
24. join k HasRight HasLeft = HasBoth k
25.
26.
27. lca :: [Tree] -> Int -> Int -> Maybe Int
28. lca roots m n = answer (map ancestor roots)
29.   where extend :: Tree -> Result -> Result
30.         extend t = if index t == m then addLeft
31.                    else if index t == n then addRight
32.                    else id
33.            where addLeft HasRight    = HasBoth (index t)
35.                  addRight HasLeft    = HasBoth (index t)
37.         ancestor t@(Empty _) = extend t HasNeither
38.         ancestor t@(Pair n left right) =
39.             extend t (join n (ancestor left) (ancestor right))
40.         answer :: [Result] -> Maybe Int
41.         answer (HasBoth n : _) = Just n
42.         answer (HasLeft : _) = Nothing
43.         answer (HasRight : _) = Nothing
46.
47. tree0, tree1 :: Tree
48.
49. {-
50.
51.     0       1
52.    / \     / \
53.   2   3   4   5
54.  / \         / \
55. 6   7       8   9
56.    / \
57.  10   11
58.
59. -}
60.
61. tree0 = Pair 0 two three
62.   where two = Pair 2 six seven
63.         three = Empty 3
64.         six = Empty 6
65.         seven = Pair 7 ten eleven
66.         ten = Empty 10
67.         eleven = Empty 11
68.
69. tree1 = Pair 1 four five
70.     where four = Empty 4
71.           five = Pair 5 eight nine
72.           eight = Empty 8
73.           nine = Empty 9
74.
75. forest :: [Tree]
76. forest = [tree0, tree1]
77.
78.
79. test = lca forest
clone this paste RAW Paste Data
Top