home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Splayset.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  7.5 KB  |  223 lines  |  [TEXT/R*ch]
  1. (* Splayset -- modified for Moscow ML 1995-04-22
  2.  * from SML/NJ library v. 0.2
  3.  *
  4.  * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  
  5.  * See file mosml/copyrght/copyrght.att for details.
  6.  *
  7.  * Set of values with an ordering relation, implemented as splay-trees.
  8.  *)
  9.  
  10. open Splaytree
  11.  
  12. datatype 'key set = 
  13.   OS of {cmpKey : 'key * 'key -> order,
  14.      root   : 'key splay ref,
  15.      nobj   : int}
  16.  
  17. exception NotFound
  18. fun cmpf cmpKey k = fn k' => cmpKey(k',k)
  19.  
  20. fun empty cmpKey = OS{cmpKey = cmpKey, root = ref SplayNil, nobj = 0}
  21.  
  22. fun singleton cmpKey v = 
  23.     OS{cmpKey= cmpKey, 
  24.        root = ref(SplayObj{value=v,left=SplayNil,right=SplayNil}),
  25.        nobj=1}
  26.  
  27. (* Primitive insertion. *)
  28. fun insert cmpKey (v,(nobj,root)) =
  29.       case splay (cmpf cmpKey v, root) of
  30.         (_,SplayNil) => 
  31.           (1,SplayObj{value=v,left=SplayNil,right=SplayNil})
  32.       | (EQUAL,SplayObj{value,left,right}) => 
  33.           (nobj,SplayObj{value=v,left=left,right=right})
  34.       | (LESS,SplayObj{value,left,right}) => 
  35.           (nobj+1,
  36.            SplayObj{
  37.              value=v,
  38.              left=SplayObj{value=value,left=left,right=SplayNil},
  39.              right=right})
  40.       | (GREATER,SplayObj{value,left,right}) => 
  41.           (nobj+1,
  42.            SplayObj{
  43.               value=v,
  44.               left=left,
  45.               right=SplayObj{value=value,left=SplayNil,right=right}})
  46.  
  47. (* Add an item. *)
  48. fun add (OS{cmpKey,root,nobj},v) = let
  49.       val (cnt,t) = insert cmpKey (v,(nobj,!root))
  50.       in
  51.         OS{cmpKey=cmpKey, nobj=cnt, root=ref t}
  52.       end
  53.  
  54. (* Insert a list of items. *)
  55. fun addList (OS{cmpKey,root,nobj},l) = let
  56.       val (cnt,t) = List.foldl (insert cmpKey) (nobj,!root) l
  57.       in OS{cmpKey=cmpKey, nobj=cnt, root=ref t} end
  58.  
  59. (* Look for an item, return NONE if the item doesn't exist *)
  60. fun peek (d as OS{cmpKey,root,nobj}, key) =
  61.       case splay (cmpf cmpKey key, !root) of
  62.         (_,SplayNil) => NONE
  63.       | (EQUAL,r as SplayObj{value,...}) => (root := r; SOME value)
  64.       | (_,r) => (root := r; NONE)
  65.  
  66. (* Find an item *)
  67. fun member arg = case peek arg of NONE => false | SOME _ => true
  68.  
  69. (* Find an item, raising NotFound if not found *)
  70. fun retrieve arg = case peek arg of NONE => raise NotFound | SOME v => v
  71.  
  72. (* Remove an item.
  73.  * Raise NotFound if not found
  74.  *)
  75. fun delete (OS{cmpKey,root,nobj},key) =
  76.   case splay (cmpf cmpKey key, !root) of
  77.     (_,SplayNil) => raise NotFound
  78.   | (EQUAL,SplayObj{value,left,right}) => 
  79.       OS{cmpKey=cmpKey, root=ref(join(left,right)), nobj=nobj-1}
  80.   | (_,r) => (root := r; raise NotFound)
  81.  
  82.     (* Return the number of items in the table *)
  83. fun numItems (OS{nobj,...}) = nobj
  84.  
  85. fun isEmpty (OS{nobj=0,...}) = true
  86.   | isEmpty _ = false
  87.  
  88. local
  89.   fun member cmpKey (x,tree) = let
  90.         fun mbr SplayNil = false
  91.           | mbr (SplayObj{value,left,right}) =
  92.               case cmpKey (x,value) of
  93.                 LESS => mbr left
  94.               | GREATER => mbr right
  95.               | _ => true
  96.       in mbr tree end
  97.  
  98.     (* true if every item in t is in t' *)
  99.   fun treeIn cmpKey (t,t') = let
  100.         fun isIn SplayNil = true
  101.           | isIn (SplayObj{value,left=SplayNil,right=SplayNil}) =
  102.               member cmpKey (value, t')
  103.           | isIn (SplayObj{value,left,right=SplayNil}) =
  104.               member cmpKey (value, t') andalso isIn left
  105.           | isIn (SplayObj{value,left=SplayNil,right}) =
  106.               member cmpKey (value, t') andalso isIn right
  107.           | isIn (SplayObj{value,left,right}) =
  108.               member cmpKey (value, t') andalso isIn left andalso isIn right
  109.         in
  110.           isIn t
  111.         end
  112. in
  113. fun isSubset (OS{cmpKey,root=rt,nobj=n},OS{root=rt',nobj=n',...}) =
  114.       n<=n' andalso treeIn cmpKey (!rt,!rt');
  115.  
  116. fun equal (OS{cmpKey,root=rt,nobj=n},OS{root=rt',nobj=n',...}) =
  117.     n=n' andalso treeIn cmpKey (!rt,!rt');
  118. end
  119.  
  120. fun split cmpKey value s =
  121.       case splay(cmpf cmpKey value, s) of
  122.         (EQUAL,SplayObj{value,left,right}) => (SOME value, left, right)
  123.       | (LESS,SplayObj{value,left,right}) => (NONE, SplayObj{value=value,left=left,right=SplayNil},right)
  124.       | (GREATER,SplayObj{value,left,right}) => (NONE, left, SplayObj{value=value,right=right,left=SplayNil})
  125.       | (_,SplayNil) => (NONE, SplayNil, SplayNil)
  126.  
  127. fun intersection (s as OS{nobj=0,...},_) = s
  128.   | intersection (_,s as OS{nobj=0,...}) = s
  129.   | intersection (OS{cmpKey,root,...},OS{root=root',...}) =
  130.     let fun inter SplayNil _ = (SplayNil,0)
  131.       | inter _ SplayNil = (SplayNil,0)
  132.       | inter s (SplayObj{value,left,right}) =
  133.         case split cmpKey value s of
  134.         (SOME v, l, r) =>
  135.                     let val (l',lcnt) = inter l left
  136.                         val (r',rcnt) = inter r right
  137.                     in (SplayObj{value=v,left=l',right=r'},lcnt+rcnt+1) end
  138.           | (_,l,r) =>
  139.                     let val (l',lcnt) = inter l left
  140.                         val (r',rcnt) = inter r right
  141.                     in (join(l',r'),lcnt+rcnt) end
  142.           val (root,cnt) = inter (!root) (!root')
  143.     in OS{cmpKey = cmpKey, root = ref root, nobj = cnt} end
  144.  
  145. fun count st =
  146.     let fun cnt SplayNil n = n
  147.       | cnt (SplayObj{left,right,...}) n = cnt left (cnt right (n+1))
  148.     in cnt st 0 end
  149.  
  150. fun difference (s as OS{nobj=0,...},_) = s
  151.   | difference (s,OS{nobj=0,...}) = s
  152.   | difference (OS{cmpKey, root,...}, OS{root=root',...}) =
  153.     let fun diff SplayNil _ = (SplayNil,0)
  154.       | diff s SplayNil = (s, count s)
  155.       | diff s (SplayObj{value,right,left}) =
  156.         let val (_,l,r)   = split cmpKey value s
  157.         val (l',lcnt) = diff l left
  158.         val (r',rcnt) = diff r right
  159.         in (join(l',r'),lcnt+rcnt) end
  160.     val (root,cnt) = diff (!root) (!root')
  161.     in OS{cmpKey = cmpKey, root = ref root, nobj = cnt} end
  162.  
  163. fun union (OS{nobj=0,...},s) = s
  164.   | union (s,OS{nobj=0,...}) = s
  165.   | union (OS{cmpKey, root,...}, OS{root=root',...}) =
  166.       let fun uni SplayNil s = (s,count s)
  167.             | uni s SplayNil = (s, count s)
  168.             | uni s (SplayObj{value,right,left}) =
  169.                 let val (_,l,r) = split cmpKey value s
  170.                     val (l',lcnt) = uni l left
  171.                     val (r',rcnt) = uni r right
  172.                 in
  173.                   (SplayObj{value=value,right=r',left=l'},lcnt+rcnt+1)
  174.                 end
  175.           val (root,cnt) = uni (!root) (!root')
  176.       in
  177.         OS{cmpKey = cmpKey, root = ref root, nobj = cnt}
  178.       end
  179.  
  180. (* Return a list of the items (and their keys) in the dictionary *)
  181. fun listItems (OS{root,...}) =
  182.     let fun apply SplayNil                     res = res
  183.           | apply (SplayObj{value,left,right}) res =
  184.               apply left (value :: apply right res)
  185.     in apply (!root) [] end
  186.  
  187. (* Apply a function to the entries of the dictionary *)
  188. fun app af (OS{root,...}) =
  189.       let fun apply SplayNil = ()
  190.             | apply (SplayObj{value,left,right}) = 
  191.                 (apply left; af value; apply right)
  192.     in
  193.       apply (!root)
  194.     end
  195.  
  196. fun revapp af (OS{root,...}) =
  197.     let fun apply SplayNil = ()
  198.       | apply (SplayObj{value,left,right}) = 
  199.         (apply right; af value; apply left)
  200.     in apply (!root) end
  201.  
  202. (* Fold function *)
  203. fun foldr abf b (OS{root,...}) =
  204.     let fun apply SplayNil                     res = res
  205.       | apply (SplayObj{value,left,right}) res =
  206.         apply left (abf(value, apply right res))
  207.     in apply (!root) b end
  208.  
  209. fun foldl abf b (OS{root,...}) =
  210.     let fun apply SplayNil                     res = res
  211.       | apply (SplayObj{value,left,right}) res =
  212.         apply right (abf(value, apply left b))
  213.     in apply (!root) b end
  214.  
  215. fun find p (OS{root,...}) = 
  216.     let fun ex SplayNil = NONE
  217.       | ex (SplayObj{value=v,left=l,right=r}) =
  218.             if p v then SOME v
  219.             else case ex l of
  220.         NONE => ex r
  221.           | a => a 
  222.     in ex (!root) end
  223.