-
Notifications
You must be signed in to change notification settings - Fork 3
/
MTree.hs
123 lines (104 loc) · 4.35 KB
/
MTree.hs
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
module MTree ( MTree
, mnil
, misNil
, misNode
, mleftSub
, mrightSub
, mtreeVal
, minsTree
, mfindVal
, mdelete
, mminTree
, mmaxTree
, mindexT
, msuccessor
, mancientor
, mcloset ) where
import Data.Maybe ( isNothing
, isJust
, fromJust )
data Decode a = Decode { elenode :: a
, occur :: Int
, treesize :: Int }
deriving (Eq, Show)
data MTree a = MNil | MNode (Decode a) (MTree a) (MTree a) deriving (Show, Eq)
mnil :: MTree a
mnil = MNil
misNil :: MTree a -> Bool
misNil MNil = False
misNil MNode {} = True
misNode :: MTree a -> Bool
misNode = not . misNil
mleftSub :: MTree a -> MTree a
mleftSub MNil = MNil
mleftSub (MNode _ l _) = l
mrightSub :: MTree a -> MTree a
mrightSub MNil = MNil
mrightSub (MNode _ _ r) = r
mtreeVal :: MTree a -> Maybe a
mtreeVal MNil = Nothing
mtreeVal (MNode (Decode v _ _) _ _) = Just v
mfindVal :: (Eq a, Ord a) => a -> MTree a -> Maybe (a, Int)
mfindVal _ MNil = Nothing
mfindVal v (MNode (Decode ndv oc _) rht lht)
| v == ndv = Just (ndv, oc)
| v < ndv = mfindVal v rht
| otherwise = mfindVal v lht
mminTree :: (Eq a, Ord a) => MTree a -> Maybe a
mminTree MNil = Nothing
mminTree (MNode (Decode ndv _ _) rht _)
| misNil rht = Just ndv
| otherwise = mminTree rht
mmaxTree :: (Eq a, Ord a) => MTree a -> Maybe a
mmaxTree MNil = Nothing
mmaxTree (MNode (Decode ndv _ _) _ lht)
| misNil lht = Just ndv
| otherwise = mmaxTree lht
minsTree :: (Eq a, Ord a) => a -> MTree a -> MTree a
minsTree v MNil = MNode (Decode v 1 1) MNil MNil
minsTree v (MNode (Decode ndv ocr sz) lhs rhs)
| v == ndv = MNode (Decode ndv (ocr + 1) sz) lhs rhs
| v > ndv = MNode (Decode ndv ocr (sz + 1)) lhs (minsTree v rhs)
| otherwise = MNode (Decode ndv ocr (sz + 1)) (minsTree v lhs) rhs
mdelete :: (Ord a, Eq a) => a -> MTree a -> MTree a
mdelete _ MNil = MNil
mdelete v (MNode (Decode ndv occ trsz) lht rht)
| v < ndv = MNode (Decode ndv occ (trsz - 1)) (mdelete v lht) rht
| v > ndv = MNode (Decode ndv occ (trsz - 1)) lht (mdelete v rht)
| misNil rht = lht
| misNil lht = rht
| otherwise = MNode (Decode _max occ_ twosz) lht (mdelete _max rht)
where twosz = treesz lht + treesz rht :: Int
(Just max_) = mmaxTree rht
(Just (_max, occ_)) = mfindVal max_ rht
treesz :: MTree a -> Int
treesz MNil = 0
treesz (MNode (Decode _ _ s) _ _) = s
mindexT :: Int -> MTree a -> Maybe a
mindexT _ MNil = Nothing
mindexT n tr@ (MNode (Decode ndv _ sz) lh rh)
| n > sz = Nothing
| n == sz = Just ndv
| n < (treesz . mleftSub) tr = mindexT n lh
| otherwise = mindexT (n - treesz lh - 1) rh
msuccessor :: (Eq a, Ord a) => a -> MTree a -> Maybe a
msuccessor _ MNil = Nothing
msuccessor v (MNode (Decode ndv _ _) MNil MNil) = if ndv > v then Just ndv else Nothing
msuccessor v (MNode (Decode ndv _ _) tl tr)
| v < ndv = msuccessor v (minsTree ndv tl)
| otherwise = msuccessor v tr
mancientor :: (Eq a, Ord a) => a -> MTree a -> Maybe a
mancientor _ MNil = Nothing
mancientor v (MNode (Decode ndv _ _) MNil MNil) = if ndv < v then Just ndv else Nothing
mancientor v (MNode (Decode ndv _ _) tl tr)
| v > ndv = msuccessor v (minsTree ndv tr)
| otherwise = msuccessor v tl
mcloset :: Int -> MTree Int -> Int
mcloset val tree
| isNothing sucs = fromJust anct
| isNothing anct = fromJust sucs
| otherwise = clsr (fromJust anct) (fromJust sucs) val
where sucs = msuccessor val tree
anct = mancientor val tree
clsr :: Int -> Int -> Int -> Int
clsr vl vr _val = if _val - vl > vr - _val then vr else vl