-
Notifications
You must be signed in to change notification settings - Fork 1
/
SortedSequence.hs
47 lines (38 loc) · 1.69 KB
/
SortedSequence.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
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module SortedSequence (SortedSequence, MeasuredOrd(..), emptySortedSequence, toList, split, insert, removeMin, concatSorted) where
import Data.FingerTree (FingerTree, Measured (..), ViewL (..), empty,
viewl, (<|), (><))
import qualified Data.FingerTree as F (null, split)
import Data.Monoid (Monoid (..))
data MeasuredOrd a = Min | MeasuredOrd a deriving (Eq, Ord, Show)
instance Ord a => Monoid (MeasuredOrd a) where
mappend (MeasuredOrd a) (MeasuredOrd b) = MeasuredOrd (max a b)
mappend Min (MeasuredOrd a) = MeasuredOrd a
mappend (MeasuredOrd a) Min = MeasuredOrd a
mappend Min Min = Min
mempty = Min
instance Ord v => Measured (MeasuredOrd v) (MeasuredOrd v) where
measure = id
type SortedSequence a = FingerTree (MeasuredOrd a) (MeasuredOrd a)
emptySortedSequence :: Ord a => SortedSequence a
emptySortedSequence = empty
toList :: Ord a => SortedSequence a -> [a]
toList xs
| F.null xs = []
| otherwise = x:toList xs'
where (MeasuredOrd x :< xs') = viewl xs
split :: Ord a => a -> SortedSequence a -> (SortedSequence a, SortedSequence a)
split x = F.split (>= MeasuredOrd x)
removeMin :: Ord a => SortedSequence a -> SortedSequence a
removeMin ss
| F.null ss = ss
| otherwise = ss'
where (_ :< ss') = viewl ss
insert :: Ord a => a -> SortedSequence a -> SortedSequence a
insert x ss = smaller >< (MeasuredOrd x <| larger)
where (smaller,larger) = split x ss
concatSorted :: Ord a => SortedSequence a -> SortedSequence a -> SortedSequence a
concatSorted a b = a >< b