Commit f753cdb0 authored by Giuseppe Castagna's avatar Giuseppe Castagna

added code for patricia trees

parent 7fedc432
(* Patricia trees
Chris Okasaki and Andrew Gill's paper Fast Mergeable Integer Maps
http://ittc.ku.edu/~andygill/papers/IntMap98.pdf
*)
type Leaf = <leaf key=Caml_int> 'a
type Branch = <brch pre=Caml_int bit=Caml_int>[ (Leaf|Branch) (Leaf|Branch) ]
type Dict = [] | Branch | Leaf
let lowest_bit (x: Caml_int): Caml_int = Pervasives.land x ((0 - x):?Caml_int)
let branching_bit (p0: Caml_int)(p1: Caml_int): Caml_int = lowest_bit (Pervasives.lxor p0 p1)
let mask (p: Caml_int) (m: Caml_int): Caml_int =
Pervasives.land p (Pervasives.pred m)
let match_prefix (k: Caml_int)(p: Caml_int)(m: Caml_int): Bool =
mask p m = k
let zero_bit (k: Caml_int)(m: Caml_int): Bool = Pervasives.land k m = 0
let lookup (k: Caml_int)(d: Dict) : ['a?] =
match d with
| [] -> []
| <brch pre=p bit=m>[ t0 t1 ] ->
if not (match_prefix k p m) then []
else if zero_bit k m then lookup k t0
else lookup k t1
| <leaf key=j> x -> if j=k then [ x ] else []
let join (p0: Caml_int)(t0: Dict\[])(p1: Caml_int)(t1: Dict\[]): Branch =
let m = branching_bit p0 p1 in
if zero_bit p0 m then
<brch pre=(mask p0 m) bit=m>[t0 t1]
else
<brch pre=(mask p0 m) bit=m>[t1 t0]
let insert (c: 'a -> 'a -> 'a) (k: Caml_int) (x: 'a) (t: Dict): Leaf|Branch =
let ins (Leaf|Branch -> Leaf|Branch ; [] -> Leaf )
| [] -> <leaf key=k> x
| (<leaf key=j>y)&t ->
if j=k then <leaf key=k>(c x y)
else join k (<leaf key=k>x) j t
| (<brch pre=p bit=m>[ t0 t1 ])&t ->
if match_prefix k p m then
if zero_bit k m then <brch pre=p bit=m>[ (ins t0) t1 ]
else <brch pre=p bit=m>[ t0 (ins t1) ]
else join k (<leaf key=k>x) p t
in ins t
let max (x: 'a)(y: 'a): 'a = if (x >> y) then x else y;;
let swap (f : 'a -> 'a -> 'a) (x: 'a)(y: 'a): 'a = f y x;;
let merge (c: 'a -> 'a -> 'a): (Dict,Dict) -> Dict =
fun aux( ([],[]) -> []
; (Dict,Dict)\([],[]) -> Dict\[]
; (Branch,Branch) -> Branch )
| ([],t) | (t,[]) -> t
| (<leaf key=k>x , t) -> insert c k x t
| (t , <leaf key=k>x) -> insert (swap c) k x t
| (<brch pre=p bit=m>[ s0 s1 ] , <brch pre=q bit=n>[ t0 t1 ])&(s,t) ->
if (m=n) && (p=q) then <brch pre=p bit=m>[ (aux(s0,t0)) (aux(s1,t1)) ]
else if (m << n) && (match_prefix q p m) then
if zero_bit q m then <brch pre=p bit=m>[ (aux(s0,t)) s1 ]
else <brch pre=p bit=m>[ s0 (aux(s1,t)) ]
else if (m >> n) && (match_prefix p q n) then
if zero_bit p n then <brch pre=q bit=n>[ (aux(s,t0)) t1 ]
else <brch pre=q bit=n>[ t0 (aux(s,t1)) ]
else join p s q t
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment