Haskell实现的Splay树

三周的军训总算挺过去了,这里的网络条件比想象中要糟糕不少。
其实有很多要说,还是等到“十一长假”回家了再慢慢说吧。

废话不多说了,这是一个用 Haskell 实现的 Top-down Splay tree

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
module SplayTree (
SplayTree,
splay,
insert,
delete,
empty,
) where
data SplayTree a = Nil | Node a (SplayTree a) (SplayTree a)
deriving (Eq, Show)
splay :: (Ord a) => (a -> Ordering) -> SplayTree a -> SplayTree a
splay comp t = walk t Nil Nil
where
walk Nil _ _ = Nil
walk t@(Node nx l r) lspine rspine =
case comp nx of
LT -> case l of
Nil -> final t lspine rspine
Node nl a b -> if comp nl == LT && a /= Nil then walk a lspine (Node nl rspine (Node nx b r))
else walk l lspine (Node nx rspine r)
GT -> case r of
Nil -> final t lspine rspine
Node nr c d -> if comp nr == GT && d /= Nil then walk d (Node nr (Node nx l c) lspine) rspine
else walk r (Node nx l lspine) rspine
EQ -> final t lspine rspine
final g@(Node x l r) lspine rspine = Node x (lfinal l lspine) (rfinal r rspine)
lfinal l Nil = l
lfinal l (Node y a b) = lfinal (Node y a l) b
rfinal r Nil = r
rfinal r (Node y a b) = rfinal (Node y r b) a
insert :: (Ord a) => a -> SplayTree a -> SplayTree a
insert key Nil = Node key Nil Nil
insert key t =
let t'@(Node nx l r) = splay (compare key) t
in if key < nx then Node key l (Node nx Nil r)
else Node key (Node nx l Nil) r
delete :: (Ord a) => a -> SplayTree a -> SplayTree a
delete key Nil = Nil
delete key t =
let t'@(Node nx l r) = splay (compare key) t
in case compare key nx of
EQ -> if l == Nil then r
else (\(Node nl a _) -> Node nl a r) $ splay (const GT) l
_ -> t'
empty = Nil
-- Test.QuickCheck
prop_insert_delete :: [Int] -> Bool
prop_insert_delete xs = foldr delete (foldr insert empty xs) xs == Nil