summaryrefslogtreecommitdiff
path: root/Data/Tree/Splay.hs
blob: 496ffac90429d33bbbe711f7da701461191c2925 (plain)
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
--
-- Copyright (c) 2009 Brendan Hickey - http://bhickey.net
-- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)
--

module Data.Tree.Splay 
(SplayTree, head, tail, singleton, empty, null, fromList, fromAscList, toList, toAscList, insert, lookup) 
where

import Prelude hiding (head, tail, lookup, null)

data (Ord k) => SplayTree k v = 
    Leaf
  | SplayTree k v (SplayTree k v) (SplayTree k v) deriving (Ord, Eq)

-- | /O(1)/. 'singleton' constructs a splay tree containing one element.
singleton :: (Ord k) => (k,v) -> SplayTree k v
singleton (k,v) = SplayTree k v Leaf Leaf

-- | /O(1)/. 'empty' constructs an empty splay tree.
empty :: (Ord k) => SplayTree k v
empty = Leaf

-- | /O(1)/. 'null' returns true if a splay tree is empty.
null :: (Ord k) => SplayTree k v -> Bool
null Leaf = True
null _ = False


-- | /Amortized O(lg n)/. Given a splay tree and a key, 'lookup' attempts to find a node with the specified key and splays this node to the root. If the key is not found, the nearest node is brought to the root of the tree.
lookup :: (Ord k) => SplayTree k v -> k -> SplayTree k v
lookup Leaf _ = Leaf
lookup n@(SplayTree k v l r) sk =
  if sk == k
  then n
  else if k > sk
       then case lookup l sk of
              Leaf -> n
              (SplayTree k1 v1 l1 r1) -> (SplayTree k1 v1 l1 (SplayTree k v r1 r))
       else case lookup r sk of
              Leaf -> n
              (SplayTree k1 v1 l1 r1) -> (SplayTree k1 v1 (SplayTree k v l l1) r1)

-- | /Amortized O(lg n)/. Given a splay tree and a key-value pair, 'insert' places the the pair into the tree in BST order.
insert :: (Ord k) => SplayTree k v -> (k,v) -> SplayTree k v
insert t (k,v) =
  case lookup t k of
    Leaf -> (SplayTree k v Leaf Leaf)
    (SplayTree k1 v1 l r) ->
        if k1 < k
        then (SplayTree k v (SplayTree k1 v1 l Leaf) r)
        else (SplayTree k v l (SplayTree k1 v1 Leaf r))


-- | /O(1)/. 'head' returns the key-value pair of the root.
head :: (Ord k) => SplayTree k v -> (k,v)
head Leaf = error "head of empty tree"
head (SplayTree k v _ _) = (k,v)

-- | /Amortized O(lg n)/. 'tail' removes the root of the tree and merges its subtrees
tail :: (Ord k) => SplayTree k v -> SplayTree k v
tail Leaf = error "tail of empty tree"
tail (SplayTree _ _ Leaf r) = r
tail (SplayTree _ _ l Leaf) = l
tail (SplayTree _ _ l r)    = 
  case splayRight l of
    (SplayTree k v l1 Leaf) -> (SplayTree k v l1 r)
    _ -> error "splay tree corruption"

splayRight :: (Ord k) => SplayTree k v -> SplayTree k v
splayRight Leaf = Leaf
splayRight h@(SplayTree _ _ _ Leaf) = h
splayRight (SplayTree k1 v1 l1 (SplayTree k2 v2 l2 r2))  = splayRight $ (SplayTree k2 v2 (SplayTree k1 v1 l1 l2) r2)

splayLeft :: (Ord k) => SplayTree k v -> SplayTree k v
splayLeft Leaf = Leaf
splayLeft h@(SplayTree _ _ Leaf _) = h
splayLeft (SplayTree k1 v1 (SplayTree k2 v2 l2 r2) r1)  = splayLeft $ (SplayTree k2 v2 l2 (SplayTree k1 v1 r2 r1))

-- | /O(n lg n)/. Constructs a splay tree from an unsorted list of key-value pairs.
fromList :: (Ord k) => [(k,v)] -> SplayTree k v
fromList [] = Leaf
fromList l = foldl (\ acc x -> insert acc x) Leaf l

-- | /O(n lg n)/. Constructs a splay tree from a list of key-value pairs sorted in ascending order.
fromAscList :: (Ord k) => [(k,v)] -> SplayTree k v
fromAscList = fromList

-- | /O(n lg n)/. Converts a splay tree into a list of key-value pairs with no constraint on ordering.
toList :: (Ord k) => SplayTree k v -> [(k,v)]
toList = toAscList

-- | /O(n lg n)/. 'toAscList' converts a splay tree to a list of key-value pairs sorted in ascending order.
toAscList :: (Ord k) => SplayTree k v -> [(k,v)]
toAscList h@(SplayTree _ _ Leaf _) = (head h):(toAscList $ tail h)
toAscList Leaf = []
toAscList h = toAscList $ splayLeft h