Pastebin launched a little side project called HostCabi.net, check it out ;-)Don't like ads? PRO users don't see any ads ;-)
Guest

LCA for array-based forests

By: a guest on Jun 11th, 2010  |  syntax: Haskell  |  size: 1.88 KB  |  hits: 79  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
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)
  34.                  addLeft HasNeither  = HasLeft
  35.                  addRight HasLeft    = HasBoth (index t)
  36.                  addRight HasNeither = HasRight
  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
  44.         answer (HasNeither : results) = answer results
  45.         answer [] = 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