Facebook
From Big Eider, 6 Years ago, written in Plain Text.
Embed
Download Paste or View Raw
Hits: 211
  1. type 'a llist = LEmpty | LCons of 'a * (unit -> 'a llist);;
  2.  
  3. module BST :
  4. sig
  5. (*type 'a llist*)
  6. val create: unit -> unit
  7. val push: 'a -> unit
  8. val remove: int -> unit
  9. val find: int -> bool
  10. val getBFS: unit -> int llist
  11. val getDFS: unit -> int llist
  12. val llistToNormal: int llist -> int list
  13. end=
  14. struct
  15. (*type 'a llist = LEmpty | LCons of 'a * (unit -> 'a llist)*)
  16. type 'a nnode = Empty | Node of 'a * 'a nnode * 'a nnode
  17. let root = ref Empty
  18.  
  19. (* If root isn't empty, function clears it *)
  20. let create() = root := Empty
  21.  
  22. (* Add item to tree *)
  23. let push(elem) =
  24. let rec add = function
  25. | Node(v, l, r) -> if elem > v then
  26. Node(v, l, add r)
  27. else
  28. Node(v, add l, r)
  29. | Empty -> Node(elem, Empty, Empty)
  30. in root := add(!root)
  31.  
  32. (* Search for successor of specified node and remove it*)
  33. let rec findSuccessor = function
  34. | Node(v, l, r) ->
  35. if l = Empty then (v, r)
  36. else
  37. let (value, result) = findSuccessor(l) in
  38. (value, Node(v, result, r))
  39. | Empty -> Null, Empty
  40.  
  41. (* Remove specified item from the tree *)
  42. let remove(elem) =
  43. let rec removeNode = function
  44. | Node(v, l, r) ->
  45. if v = elem then
  46. let (value, result) = findSuccessor(r) in
  47. if result = Empty then
  48. l
  49. else
  50. Node(value, l, result)
  51. else
  52. if elem < v then
  53. Node(v, removeNode l, r)
  54. else
  55. Node(v, l, removeNode r)
  56. | Empty -> Empty
  57. in root := removeNode(!root)
  58.  
  59. (* Find element in the tree *)
  60. let find(elem) =
  61. let rec find = function
  62. | Node(v, l, r) ->
  63. if v = elem then true
  64. else
  65. if elem < v then find(l)
  66. else find(r)
  67. | Empty -> false
  68. in find(!root)
  69.  
  70. (* Create lazy list out of tree nodes using DFS preorder algorithm*)
  71. let getDFS() =
  72. let rec depth = function
  73. | [] -> LEmpty
  74. | Empty::t -> depth(t)
  75. | Node(v, l, r)::t -> LCons(v, fun() -> depth( [l; r] @ t))
  76. in depth [!root]
  77.  
  78. (* Create lazy list out of tree nodes using BFS algorithm*)
  79. let getBFS()=
  80. let rec breadth = function
  81. | [] -> LEmpty
  82. | Empty::t -> breadth(t)
  83. | Node(v, l, r)::t -> LCons(v, fun() -> breadth( t @ [l; r] ))
  84. in breadth [!root]
  85.  
  86. (* Transform lazy list to normal *)
  87. let rec llistToNormal = function
  88. | LCons(v, f) -> v::llistToNormal(f())
  89. | LEmpty -> []
  90. end;;
  91.  
  92. BST.create();;
  93. BST.push(5);;
  94. BST.push(4);;
  95. BST.push(3);;
  96. BST.push(2);;
  97. BST.push(1);;
  98.  
  99. BST.remove(3);;
  100.  
  101. BST.llistToNormal(BST.getBFS());;
  102.  
  103. BST.create();;
  104. BST.push(5);;
  105. BST.push(3);;
  106. BST.push(4);;
  107. BST.push(1);;
  108. BST.push(8);;
  109. BST.push(9);;
  110. BST.push(7);;
  111.  
  112. BST.llistToNormal(BST.getBFS());;
  113. BST.llistToNormal(BST.getDFS());;