Skip to content

Instantly share code, notes, and snippets.

@zlotnleo

zlotnleo/234Tree.sml

Created June 2, 2017 18:03
Show Gist options
  • Save zlotnleo/bbdb1c419973bbd5897dceae2e536727 to your computer and use it in GitHub Desktop.
Save zlotnleo/bbdb1c419973bbd5897dceae2e536727 to your computer and use it in GitHub Desktop.
Download ZIP
2-3-4 Tree
Raw
234Tree.sml
datatype 'a tree =
Lf
| Db of 'a tree * 'a * 'a tree
| Tr of 'a tree * 'a * 'a tree * 'a * 'a tree
| Qd of 'a tree * 'a * 'a tree * 'a * 'a tree * 'a * 'a tree
fun get Lf _ = raise Subscript
| get (Db(t1, (k1, v1), t2)) k =
if k < k1 then get t1 k
else if k = k1 then v1
else get t2 k
| get (Tr(t1, (k1, v1), t2, (k2, v2), t3)) k =
if k < k1 then get t1 k
else if k = k1 then v1
else if k < k2 then get t2 k
else if k = k2 then v2
else get t3 k
| get(Qd(t1, (k1, v1), t2, (k2, v2), t3, (k3, v3), t4)) k =
if k < k2 then
if k < k1 then get t1 k
else if k = k1 then v1
else get t2 k
else if k = k2 then v2
else
if k < k3 then get t3 k
else if k = k3 then v3
else get t4 k
fun min Lf = raise Subscript
| min (Db(Lf, m, _)) = m
| min (Db(t, _, _)) = min t
| min (Tr(Lf, m, _, _, _)) = m
| min (Tr(t, _, _, _, _)) = min t
| min (Qd(Lf, m, _, _, _, _, _)) = m
| min (Qd(t, _, _, _, _, _, _)) = min t
fun max Lf = raise Subscript
| max (Db(_, m, Lf)) = m
| max (Db(_, _, t)) = max t
| max (Tr(_, _, _, m, Lf)) = m
| max (Tr(_, _, _, _, t)) = max t
| max (Qd(_, _, _, _, _, m, Lf)) = m
| max (Qd(_, _, _, _, _, _, t)) = max t
fun toList Lf = []
| toList (Db(t1, m1, t2)) = toList t1 @ m1 :: toList t2
| toList (Tr(t1, m1, t2, m2, t3)) = toList t1 @ m1 :: toList t2 @ m2 :: toList t3
| toList (Qd(t1, m1, t2, m2, t3, m3, t4)) = toList t1 @ m1 :: toList t2 @ m2 :: toList t3 @ m3 :: toList t4
fun findNodeWithKey Lf _ = raise Subscript
| findNodeWithKey (n as Db(t1, (k1, _), t2)) k =
if k < k1 then findNodeWithKey t1 k
else if k = k1 then n
else findNodeWithKey t2 k
| findNodeWithKey (n as Tr(t1, (k1, _), t2, (k2, _), t3)) k =
if k < k1 then findNodeWithKey t1 k
else if k = k1 then n
else if k < k2 then findNodeWithKey t2 k
else if k = k2 then n
else findNodeWithKey t3 k
| findNodeWithKey (n as Qd(t1, (k1, _), t2, (k2, _), t3, (k3, _), t4)) k =
if k < k1 then findNodeWithKey t1 k
else if k = k1 then n
else if k < k2 then findNodeWithKey t2 k
else if k = k2 then n
else if k < k3 then findNodeWithKey t3 k
else if k = k3 then n
else findNodeWithKey t4 k
fun successor tree key =
let
fun findRight Lf = raise Subscript
| findRight (Db(_, (k1, _), t2)) =
if key = k1 then t2
else raise Subscript
| findRight (Tr(_, (k1, _), t2, (k2, v2), t3)) =
if key = k1 then Db(t2, (k2, v2), t3)
else if key = k2 then t3
else raise Subscript
| findRight (Qd(_, (k1, _), t2, (k2, v2), t3, (k3, v3), t4)) =
if key = k1 then Tr(t2, (k2, v2), t3, (k3, v3), t4)
else if key = k2 then Db(t3, (k3, v3), t4)
else if key = k3 then t4
else raise Subscript
fun successorAbove Lf succ = succ
| successorAbove (Db(t1, (k1, v1), t2)) succ =
if key < k1 then successorAbove t1 (k1, v1)
else if key = k1 then succ
else successorAbove t2 succ
| successorAbove (Tr (t1, (k1, v1), t2, (k2, v2), t3)) succ =
if key < k1 then successorAbove t1 (k1, v1)
else if key = k1 then succ
else if key < k2 then successorAbove t2 (k2, v2)
else if key = k2 then succ
else successorAbove t3 succ
| successorAbove (Qd (t1, (k1, v1), t2, (k2, v2), t3, (k3, v3), t4)) succ =
if key < k2 then
if key < k1 then successorAbove t1 (k1, v1)
else if key = k1 then (k2, v2)
else successorAbove t2 (k2, v2)
else if key = k2 then succ
else
if key < k3 then successorAbove t3 (k3, v3)
else if key = k3 then succ
else successorAbove t4 succ
in
case findRight (findNodeWithKey tree key) of
Lf =>
let
val init = min tree
val succ = successorAbove tree init
in
if succ = init then raise Subscript
else succ
end
| n => min n
end
fun predecessor tree key =
let
fun findLeft Lf = raise Subscript
| findLeft (Db(t1, (k1, _), _)) =
if key = k1 then t1
else raise Subscript
| findLeft (Tr(t1, (k1, v1), t2, (k2, _), _)) =
if key = k1 then t1
else if key = k2 then Db(t1, (k1, v1), t2)
else raise Subscript
| findLeft (Qd(t1, (k1, v1), t2, (k2, v2), t3, (k3, _), _)) =
if key = k1 then t1
else if key = k2 then Db(t1, (k1, v1), t2)
else if key = k3 then Tr(t1, (k1, v1), t2, (k2, v2), t3)
else raise Subscript
fun predecessorAbove Lf pred = pred
| predecessorAbove (Db(t1, (k1, v1), t2)) pred =
if key < k1 then predecessorAbove t1 pred
else if key = k1 then pred
else predecessorAbove t2 (k1, v1)
| predecessorAbove (Tr (t1, (k1, v1), t2, (k2, v2), t3)) pred =
if key < k1 then predecessorAbove t1 pred
else if key = k1 then pred
else if key < k2 then predecessorAbove t2 (k1, v1)
else if key = k2 then pred
else predecessorAbove t3 (k2, v2)
| predecessorAbove (Qd (t1, (k1, v1), t2, (k2, v2), t3, (k3, v3), t4)) pred =
if key < k2 then
if key < k1 then predecessorAbove t1 pred
else if key = k1 then (k2, v2)
else predecessorAbove t2 (k1, v1)
else if key = k2 then pred
else
if key < k3 then predecessorAbove t3 (k2, v2)
else if key = k3 then pred
else predecessorAbove t4 (k3, v3)
in
case findLeft (findNodeWithKey tree key) of
Lf =>
let
val init = max tree
val pred = predecessorAbove tree init
in
if pred = init then raise Subscript
else pred
end
| n => max n
end
fun insert Lf kv = Db(Lf, kv, Lf)
| insert (Db(t1, (k1, v1), t2)) (k, v) =
if k < k1 then
case t1 of
Qd(qt1, qm1, qt2, (qk2, qv2), qt3, qm3, qt4) =>
if k < qk2 then
Tr(insert (Db(qt1, qm1, qt2)) (k, v), (qk2, qv2), Db(qt3, qm3, qt4) , (k1, v1), t2)
else if k > qk2 then
Tr( Db(qt1, qm1, qt2) , (qk2, qv2), insert (Db(qt3, qm3, qt4)) (k, v), (k1, v1), t2)
else
Db( Qd(qt1, qm1, qt2, (k, v), qt3, qm3, qt4) , (k1, v1), t2)
| Lf =>
Tr( Lf , ( k , v ), Lf , (k1, v1), t2)
| _ =>
Db( insert t1 (k, v) , (k1, v1), t2)
else if k = k1 then
Db( t1 , (k , v ), t2)
else
(case t2 of
Qd(qt1, qm1, qt2, (qk2, qv2), qt3, qm3, qt4) =>
if k < qk2 then
Tr(t1, (k1, v1), insert (Db(qt1, qm1, qt2)) (k, v), (qk2, qv2), Db(qt3, qm3, qt4) )
else if k > qk2 then
Tr(t1, (k1, v1), Db(qt1, qm1, qt2) , (qk2, qv2), insert (Db(qt3, qm3, qt4)) (k, v))
else
Db(t1, (k1, v1), Qd(qt1, qm1, qt2, (k, v), qt3, qm3, qt4) )
| Lf =>
Tr(t1, (k1, v1), Lf , ( k , v ), Lf )
| _ =>
Db(t1, (k1, v1), insert t2 (k, v) )
)
| insert (Tr(t1, (k1, v1), t2, (k2, v2), t3)) (k, v) =
if k < k1 then
case t1 of
Qd(qt1, qm1, qt2, (qk2, qv2), qt3, qm3, qt4) =>
if k < qk2 then
Qd(insert (Db(qt1, qm1, qt2)) (k, v), (qk2, qv2), Db(qt3, qm3, qt4) , (k1, v1), t2, (k2, v2), t3)
else if k > qk2 then
Qd( Db(qt1, qm1, qt2) , (qk2, qv2), insert (Db(qt3, qm3, qt4)) (k, v), (k1, v1), t2, (k2, v2), t3)
else
Tr( Qd(qt1, qm1, qt2, (k, v), qt3, qm3, qt4) , (k1, v1), t2, (k2, v2), t3)
| Lf =>
Qd( Lf , ( k , v ), Lf , (k1, v1), t2, (k2, v2), t3)
| _ =>
Tr( insert t1 (k, v) , (k1, v1), t2, (k2, v2), t3)
else if k = k1 then
Tr( t1 , (k , v ), t2, (k2, v2), t3)
else if k < k2 then
case t2 of
Qd(qt1, qm1, qt2, (qk2, qv2), qt3, qm3, qt4) =>
if k < qk2 then
Qd(t1, (k1, v1), insert (Db(qt1, qm1, qt2)) (k, v), (qk2, qv2), Db(qt3, qm3, qt4) , (k2, v2), t3)
else if k > qk2 then
Qd(t1, (k1, v1), Db(qt1, qm1, qt2) , (qk2, qv2), insert (Db(qt3, qm3, qt4)) (k, v), (k2, v2), t3)
else
Tr(t1, (k1, v1), Qd(qt1, qm1, qt2, (k , v), qt3, qm3, qt4) , (k2, v2), t3)
| Lf =>
Qd(t1, (k1, v1), Lf , ( k , v ), Lf , (k2, v2), t3)
| _ =>
Tr(t1, (k1, v1), insert t2 (k, v) , (k2, v2), t3)
else if k = k2 then
Tr(t1, (k1, v1), t2 , (k , v ), t3)
else
(case t3 of
Qd(qt1, qm1, qt2, (qk2, qv2), qt3, qm3, qt4) =>
if k < qk2 then
Qd(t1, (k1, v1), t2, (k2, v2), insert (Db(qt1, qm1, qt2)) (k, v), (qk2, qv2), Db(qt3, qm3, qt4) )
else if k > qk2 then
Qd(t1, (k1, v1), t2, (k2, v2), Db(qt1, qm1, qt2) , (qk2, qv2), insert (Db(qt3, qm3, qt4)) (k, v))
else
Tr(t1, (k1, v1), t2, (k2, v2), Qd(qt1, qm1, qt2, (k, v), qt3, qm3, qt4) )
| Lf =>
Qd(t1, (k1, v1), t2, (k2, v2), Lf , ( k , v ), Lf )
| _ =>
Tr(t1, (k1, v1), t2, (k2, v2), insert t3 (k, v) )
)
| insert (Qd(t1, m1, t2, (k2, v2), t3, m3, t4)) (k, v) =
insert (Db(Db(t1, m1, t2), (k2, v2), Db(t3, m3, t4))) (k, v)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment