├── .gitignore
├── BankersQueue.hs
├── BatchedQueue.hs
├── BinomialHeap.hs
├── FingerTree.hs
├── LICENSE
├── LeftistHeap.hs
├── README.md
├── Setup.hs
└── stack.yaml
/.gitignore:
--------------------------------------------------------------------------------
1 | /.stack-work
2 |
--------------------------------------------------------------------------------
/BankersQueue.hs:
--------------------------------------------------------------------------------
1 | module BankersQueue where
2 |
3 | data Queue a = Queue
4 | { lenWrite :: !Int
5 | , write :: [a]
6 | , lenRead :: !Int
7 | , read :: [a] }
8 |
9 | check :: Queue a -> Queue a
10 | check queue@(Queue {..})
11 | | lenWrite > lenRead = Queue 0 [] (lenRead + lenWrite) (read ++ reverse write))
12 | | otherwise = queue
13 |
14 | empty :: Queue a
15 | empty = Queue 0 [] 0 []
16 |
17 | insert :: a -> Queue a -> Queue a
18 | insert a (Queue {..}) = check (Queue (lenWrite + 1) (a : write) lenRead read)
19 |
20 |
21 | view :: Queue a -> (a, Queue a)
22 | view (Queue {..}) = case read of
23 | [] -> error "Empty queue"
24 | a : read' -> (a, check (Queue lenWrite write (lenRead - 1) read'))
25 |
--------------------------------------------------------------------------------
/BatchedQueue.hs:
--------------------------------------------------------------------------------
1 | module BatchedQueue where
2 |
3 | data Queue a = Queue [a] [a]
4 |
5 | check :: Queue a -> Queue a
6 | check (Queue write []) = Queue [] (reverse write)
7 | check queue = queue
8 |
9 | empty :: Queue a
10 | empty = Queue [] []
11 |
12 | insert :: a -> Queue a -> Queue a
13 | insert a (Queue write read) = check (Queue (a : write) read)
14 |
15 | view :: Queue a -> (a, Queue a)
16 | view (Queue write (a : read')) = (a, check (Queue write read'))
17 |
--------------------------------------------------------------------------------
/BinomialHeap.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE LambdaCase #-}
2 | module BinomialHeap where
3 |
4 | import Prelude hiding (head, tail, (++))
5 |
6 | -- | Invariants:
7 | --
8 | -- * The 'forest' of a 'Tree' of 'rank' r contains exactly r trees of 'rank' r-1, …, 0
9 | -- * A 'Tree' of 'rank' n contains exactly 2^n elements
10 | -- * Elements are in heap order ('root' is the smallest element)
11 | data Tree a = Node
12 | { rank :: !Int
13 | , root :: a
14 | , forest :: ![Tree a] }
15 |
16 | -- | Always link trees of equal rank!
17 | link :: Ord a => Tree a -> Tree a -> Tree a
18 | link left right
19 | | rank left /= rank right = error "Only link trees of equal rank"
20 | | root left <= root right = Node rank' (root left) (right : forest left)
21 | | otherwise = Node rank' (root right) (left : forest right)
22 | where rank' = rank left + 1
23 |
24 |
25 |
26 | -- | Invariants:
27 | -- * The trees are stored by increasing rank
28 | newtype Heap a = Heap [Tree a]
29 |
30 |
31 | insert :: Ord a => a -> Heap a -> Heap a
32 | insert a (Heap trees) = Heap (insertTree (Node 0 a []) trees)
33 |
34 | insertTree :: Ord a => Tree a -> [Tree a] -> [Tree a]
35 | insertTree s [] = [s]
36 | insertTree s (t : ts)
37 | | rank s < rank t -- found a free spot
38 | = s : t : ts
39 | | otherwise -- must be equal rank (because of sorting) => carry
40 | = insertTree (link s t) ts
41 |
42 |
43 | merge :: Ord a => Heap a -> Heap a -> Heap a
44 | merge (Heap left) (Heap right) = Heap (mergeTrees left right)
45 |
46 | mergeTrees :: Ord a => [Tree a] -> [Tree a] -> [Tree a]
47 | mergeTrees left [] = left
48 | mergeTrees [] right = right
49 | mergeTrees (l:ls) (r:rs)
50 | | rank l > rank r = l : mergeTrees ls (r:rs)
51 | | rank l < rank r = r : mergeTrees (l:ls) rs
52 | | otherwise = link l r : mergeTrees ls rs
53 |
54 |
55 | viewMin :: Ord a => Heap a -> Maybe (a, Heap a)
56 | viewMin (Heap []) = Nothing
57 | viewMin (Heap trees) = Just (root minTree, Heap rest)
58 |
59 | where (minTree, trees') = findMinTree trees
60 | rest = mergeTrees trees' (reverse (forest minTree))
61 |
62 | findMinTree :: Ord a => [Tree a] -> (Tree a, [Tree a])
63 | findMinTree [t] = (t, [])
64 | findMinTree (t : ts)
65 | | root t < root t' = (t, ts)
66 | | otherwise = (t', t:ts')
67 | where (t', ts') = findMinTree ts
68 |
--------------------------------------------------------------------------------
/FingerTree.hs:
--------------------------------------------------------------------------------
1 | module FingerTree where
2 |
3 | import Prelude hiding (lookup)
4 |
5 | data FingerTree a
6 | = Empty
7 | | Single a
8 | | Deep !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
9 |
10 | data Digit a = One a | Two a a | Three a a a | Four a a a a
11 |
12 | data Node a = Node2 a a | Node3 a a a
13 |
14 | class Sized a where
15 | size :: a -> Int
16 |
17 | instance Sized a => Sized (FingerTree a) where
18 | size Empty = 0
19 | size (Single a) = size a
20 | size (Deep s _ _ _) = s
21 |
22 | instance Sized a => Sized (Digit a) where
23 | size (One a) = size a
24 | size (Two a b) = size a + size b
25 | size (Three a b c) = size a + size b + size c
26 | size (Four a b c d) = size a + size b + size c + size d
27 |
28 | instance Sized a => Sized (Node a) where
29 | size (Node2 a b) = size a + size b
30 | size (Node3 a b c) = size a + size b + size c
31 |
32 | instance Sized a => Sized (Maybe a) where
33 | size Nothing = 0
34 | size (Just a) = size a
35 |
36 | deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
37 | deep l t r = Deep (size l + size t + size r) l t r
38 |
39 | {-|
40 | >>> toList (cons (E 1) (cons (E 2) (cons (E 3) Empty))) :: [Int]
41 | [1,2,3]
42 |
43 | >>> toList (cons (E 5) (fromList [4,3,2,1])) :: [Int]
44 | [5,4,3,2,1]
45 | -}
46 | cons :: Sized a => a -> FingerTree a -> FingerTree a
47 | cons a Empty = Single a
48 | cons a (Single b) = deep (One a) Empty (One b)
49 | cons a (Deep s l t r) = case l of
50 | One b -> Deep s' (Two a b) t r
51 | Two b c -> Deep s' (Three a b c) t r
52 | Three b c d -> Deep s' (Four a b c d) t r
53 | Four b c d e -> t `seq` -- Push a node down the spine
54 | -- Amortization: The spine has already been paid for,
55 | -- so we can force it to prevent memory leaks
56 | Deep s' (Two a b) (Node3 c d e `cons` t) r
57 | where s' = s + size a
58 |
59 | {-|
60 | >>> toList (snoc (fromList [1..19]) (E 20)) :: [Int]
61 | [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
62 | -}
63 | snoc :: Sized a => FingerTree a -> a -> FingerTree a
64 | snoc Empty z = Single z
65 | snoc (Single y) z = deep (One y) Empty (One z)
66 | snoc (Deep s l t r) z = case r of
67 | One y -> Deep s' l t (Two y z)
68 | Two x y -> Deep s' l t (Three x y z)
69 | Three w x y -> Deep s' l t (Four w x y z)
70 | Four v w x y -> t `seq`
71 | Deep s' l (t `snoc` Node3 v w x) (Two x z)
72 | where s' = s + size z
73 |
74 | {-|
75 | >>> fmap (const ()) (viewL (fromList []))
76 | Nothing
77 |
78 | >>> let Just (E a, t) = viewL (fromList [1]) in (a, toList t)
79 | (1,[])
80 |
81 | >>> let Just (E a, t) = viewL (fromList [1,2,3]) in (a, toList t)
82 | (1,[2,3])
83 |
84 | >>> let Just (E a, t) = viewL (fromList [1..100]) in (a, toList t)
85 | (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])
86 | -}
87 | viewL :: Sized a => FingerTree a -> Maybe (a, FingerTree a)
88 | viewL Empty = Nothing
89 | viewL (Single a) = Just (a, Empty)
90 | viewL (Deep s l t r) = Just $ case l of
91 | Four a b c d -> (a, Deep (s - size a) (Three b c d) t r)
92 | Three a b c -> (a, Deep (s - size a) (Two b c) t r)
93 | Two a b -> (a, Deep (s - size a) (One b) t r)
94 | One a -> case viewL t of -- Pull a node up from the spine
95 | Just (Node3 b c d, t') -> (a, Deep (s - size a) (Three b c d) t' r)
96 | Just (Node2 b c, t') -> (a, Deep (s - size a) (Two b c) t' r)
97 | Nothing -> case r of -- If the spine is empty, balance with the right digit
98 | Four b c d e -> (a, Deep (s - size a) (Two b c) Empty (Two d e))
99 | Three b c d -> (a, Deep (s - size a) (Two b c) Empty (One d))
100 | Two b c -> (a, Deep (s - size a) (One b) Empty (One c))
101 | One b -> (a, Single b)
102 |
103 | {-|
104 | >>> fmap (const ()) (viewR (fromList []))
105 | Nothing
106 |
107 | >>> let Just (t, E a) = viewR (fromList [1]) in (toList t, a)
108 | ([],1)
109 |
110 | >>> let Just (t, E a) = viewR (fromList [1,2,3]) in (toList t, a)
111 | ([1,2],3)
112 |
113 | >>> let Just (t, E a) = viewR (fromList [1..100]) in (toList t, a)
114 | ([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)
115 | -}
116 | viewR :: Sized a => FingerTree a -> Maybe (FingerTree a, a)
117 | viewR Empty = Nothing
118 | viewR (Single a) = Just (Empty, a)
119 | viewR (Deep s l t r) = Just $ case r of
120 | Four w x y z -> (Deep (s - size z) l t (Three w x y), z)
121 | Three x y z -> (Deep (s - size z) l t (Two x y), z)
122 | Two y z -> (Deep (s - size z) l t (One y), z)
123 | One z -> case viewR t of
124 | Just (t', Node3 w x y) -> (Deep (s - size z) l t' (Three w x y), z)
125 | Just (t', Node2 x y) -> (Deep (s - size z) l t' (Two x y), z)
126 | Nothing -> case l of
127 | Four v w x y -> (Deep (s - size z) (Two v w) Empty (Two x y), z)
128 | Three w x y -> (Deep (s - size z) (Two w x) Empty (One y), z)
129 | Two x y -> (Deep (s - size z) (One x) Empty (One y), z)
130 | One y -> (Single y, z)
131 |
132 |
133 | {-|
134 | Left tree contains items < pos, right tree items >= pos
135 |
136 | >>> let (l, E a, r) = split 0 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
137 | ([],1,[2,3,4,5])
138 |
139 | >>> let (l, E a, r) = split 1 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
140 | ([],1,[2,3,4,5])
141 |
142 | >>> let (l, E a, r) = split 2 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
143 | ([1],2,[3,4,5])
144 |
145 | >>> let (l, E a, r) = split 3 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
146 | ([1,2],3,[4,5])
147 |
148 | >>> let (l, E a, r) = split 4 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
149 | ([1,2,3],4,[5])
150 |
151 | >>> let (l, E a, r) = split 5 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
152 | ([1,2,3,4],5,[])
153 |
154 | >>> let (l, E a, r) = split 6 (fromList [1,2,3,4,5]) in (toList l, a, toList r)
155 | ([1,2,3,4],5,[])
156 |
157 | >>> let (l, E a, r) = split 42 (fromList [1..100]) in (toList l, a, toList r)
158 | ([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])
159 | -}
160 | split :: Sized a => Int -> FingerTree a -> (FingerTree a, a, FingerTree a)
161 | split _ Empty = error "Cannot split an empty tree"
162 | split pos (Single a) = (Empty, a, Empty)
163 | split pos tree@(Deep s l t r)
164 | | slt < pos = let (rl, a, rr) = splitDigit (pos - slt) r
165 | in (deepR l t rl, a, maybe Empty digitToTree rr)
166 | | sl < pos = let (tl, n, tr) = split (pos - sl) t
167 | (nl, a, nr) = splitNode (pos - sl - size tl) n
168 | in (deepR l tl nl, a, deepL nr tr r)
169 | | otherwise = let (ll, a, lr) = splitDigit pos l
170 | in (maybe Empty digitToTree ll, a, deepL lr t r)
171 | where sl = size l
172 | slt = sl + size t
173 |
174 | splitDigit :: Sized a => Int -> Digit a -> (Maybe (Digit a), a, Maybe (Digit a))
175 | splitDigit _ (One a) = (Nothing, a, Nothing)
176 | splitDigit pos (Two a b)
177 | | size a < pos = (Just (One a), b, Nothing)
178 | | otherwise = (Nothing, a, Just (One b))
179 | splitDigit pos (Three a b c)
180 | | sab < pos = (Just (Two a b), c, Nothing)
181 | | sa < pos = (Just (One a), b, Just (One c))
182 | | otherwise = (Nothing, a, Just (Two b c))
183 | where sa = size a
184 | sab = sa + size b
185 | splitDigit pos (Four a b c d)
186 | | sabc < pos = (Just (Three a b c), d, Nothing)
187 | | sab < pos = (Just (Two a b), c, Just (One d))
188 | | sa < pos = (Just (One a), b, Just (Two c d))
189 | | otherwise = (Nothing, a, Just (Three b c d))
190 | where sa = size a
191 | sab = sa + size b
192 | sabc = sab + size c
193 |
194 | splitNode :: Sized a => Int -> Node a -> (Maybe (Digit a), a, Maybe (Digit a))
195 | splitNode pos (Node2 a b)
196 | | size a < pos = (Just (One a), b, Nothing)
197 | | otherwise = (Nothing, a, Just (One b))
198 | splitNode pos (Node3 a b c)
199 | | sab < pos = (Just (Two a b), c, Nothing)
200 | | sa < pos = (Just (One a), b, Just (One c))
201 | | otherwise = (Nothing, a, Just (Two b c))
202 | where sa = size a
203 | sab = sa + size b
204 |
205 | deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
206 | deepL (Just l) t r = deep l t r
207 | deepL Nothing t r = case viewL t of
208 | Just (Node3 a b c, t') -> deep (Three a b c) t' r
209 | Just (Node2 a b, t') -> deep (Two a b) t' r
210 | Nothing -> digitToTree r
211 |
212 | deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
213 | deepR l t (Just r) = deep l t r
214 | deepR l t Nothing = case viewR t of
215 | Just (t', Node3 x y z) -> deep l t' (Three x y z)
216 | Just (t', Node2 y z) -> deep l t' (Two y z)
217 | Nothing -> digitToTree l
218 |
219 | digitToTree :: Sized a => Digit a -> FingerTree a
220 | digitToTree (One a) = Single a
221 | digitToTree (Two a b) = deep (One a) Empty (One b)
222 | digitToTree (Three a b c) = deep (Two a b) Empty (One c)
223 | digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
224 |
225 |
226 | {-|
227 | >>> toList (merge (fromList [1..10]) (fromList [11..20]))
228 | [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
229 |
230 | >>> toList (merge (fromList [1..3]) (fromList [4..20]))
231 | [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
232 | -}
233 | merge :: Sized a => FingerTree a -> FingerTree a -> FingerTree a
234 | merge Empty tree = tree
235 | merge tree Empty = tree
236 | merge (Single a) tree = cons a tree
237 | merge tree (Single z) = snoc tree z
238 | merge (Deep ls ll lt lr) (Deep rs rl rt rr) = Deep (ls + rs) ll (merge4 lt lr rl rt) rr
239 |
240 | merge4 :: Sized a => FingerTree (Node a) -> Digit a -> Digit a -> FingerTree (Node a) -> FingerTree (Node a)
241 | merge4 left (One a) (One b) right = merge left (cons (Node2 a b) right)
242 | merge4 left (One a) (Two b c) right = merge left (cons (Node3 a b c) right)
243 | merge4 left (One a) (Three b c d) right = merge (snoc left (Node2 a b)) (cons (Node2 c d) right)
244 | merge4 left (One a) (Four b c d e) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) right)
245 | merge4 left (Two a b) (One c) right = merge left (cons (Node3 a b c) right)
246 | merge4 left (Two a b) (Two c d) right = merge (snoc left (Node2 a b)) (cons (Node2 c d) right)
247 | merge4 left (Two a b) (Three c d e) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) right)
248 | merge4 left (Two a b) (Four c d e f) right = merge (snoc left (Node3 a b c)) (cons (Node3 d e f) right)
249 | merge4 left (Three a b c) (One d) right = merge (snoc left (Node2 a b)) (cons (Node2 c d) right)
250 | merge4 left (Three a b c) (Two d e) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) right)
251 | merge4 left (Three a b c) (Three d e f) right = merge (snoc left (Node3 a b c)) (cons (Node3 d e f) right)
252 | merge4 left (Three a b c) (Four d e f g) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) (cons (Node2 f g) right))
253 | merge4 left (Four a b c d) (One e) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) right)
254 | merge4 left (Four a b c d) (Two e f) right = merge (snoc left (Node3 a b c)) (cons (Node3 d e f) right)
255 | merge4 left (Four a b c d) (Three e f g) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) (cons (Node2 f g) right))
256 | merge4 left (Four a b c d) (Four e f g h) right = merge (snoc left (Node3 a b c)) (cons (Node2 d e) (cons (Node3 f g h) right))
257 |
258 | {-|
259 | >>> fmap getElement (lookup 1 (fromList [1..10]))
260 | Just 1
261 |
262 | >>> fmap getElement (lookup 17 (fromList [1..100]))
263 | Just 17
264 |
265 | >>> fmap getElement (lookup 1 (fromList [1]))
266 | Just 1
267 |
268 | >>> fmap getElement (lookup 1 (fromList []))
269 | Nothing
270 | -}
271 | lookup :: Sized a => Int -> FingerTree a -> Maybe a
272 | lookup _ Empty = Nothing
273 | lookup _ (Single a) = Just a
274 | lookup pos tree = let (_, a, _) = split pos tree in Just a
275 |
276 |
277 | data Element a = E { getElement :: a }
278 | instance Sized (Element a) where size _ = 1
279 |
280 | fromList :: [a] -> FingerTree (Element a)
281 | fromList = foldr cons Empty . map E
282 |
283 | toList :: FingerTree (Element a) -> [a]
284 | toList t | Just (E a, t') <- viewL t = a : toList t'
285 | | otherwise = []
286 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright Franz Thoma (c) 2017
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of Franz Thoma nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--------------------------------------------------------------------------------
/LeftistHeap.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE LambdaCase #-}
2 | module LeftistHeap where
3 |
4 | import Prelude hiding (head, (++))
5 |
6 | data Heap a
7 | = Empty
8 | | Heap
9 | { _rank :: !Int
10 | , head :: a
11 | , left :: Heap a
12 | , right :: Heap a }
13 |
14 | rank :: Heap a -> Int
15 | rank = \case
16 | Empty -> 0
17 | Heap r _ _ _ -> r
18 |
19 | mkLeftist :: a -> Heap a -> Heap a -> Heap a
20 | mkLeftist a xs ys
21 | | rank xs < rank ys = Heap (rank xs + 1) a ys xs
22 | | otherwise = Heap (rank ys + 1) a xs ys
23 |
24 | (++) :: Ord a => Heap a -> Heap a -> Heap a
25 | Empty ++ xs = Empty
26 | xs ++ Empty = Empty
27 | xs ++ ys
28 | | head xs <= head ys = mkLeftist (head xs) (left xs) (right xs ++ ys)
29 | | otherwise = mkLeftist (head ys) (left ys) (xs ++ right ys)
30 |
31 | insert :: Ord a => a -> Heap a -> Heap a
32 | insert a Empty = mkLeftist a Empty Empty
33 | insert a xs
34 | | a <= head xs = mkLeftist a xs Empty
35 | | otherwise = mkLeftist (head xs) (insert a (left xs)) (right xs)
36 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | Purely Functional Data Structures
2 | ================================================================================
3 |
4 | ## Linked Lists
5 |
6 | ```haskell
7 | -- Builtin syntax, but would be defined like that
8 | data [a] -- [a] = »List of items of type `a`«
9 | = [] -- Pronounced »Nil«: empty list
10 | | a : List a -- Pronounced »Cons«: Prepends an element to a List
11 | ```
12 |
13 | Syntactical sugar:
14 |
15 | [1,2,3] ≡ 1 : (2 : (3 : []))
16 |
17 | [1..10] ≡ 1 : 2 : 3 : 4 : 5 : 6 : 7 : 8 : 9 : 10 : []
18 |
19 | Pattern Matching (list deconstruction):
20 |
21 | ```haskell
22 | case list of
23 | [] -> ...
24 | x : xs -> ...
25 | ```
26 |
27 |
28 | ### Memory Layout
29 |
30 | x : [] x : y : z : []
31 |
32 | ┌───┐ ┌───┐ ┌───┐ ┌───┐
33 | │ x ├───[] │ x ├─│ y ├─│ z ├───[]
34 | └───┘ └───┘ └───┘ └───┘
35 |
36 | Each `Cons` cell contains an element, and a pointer to the next element.
37 |
38 | ... if the list is evaluated at all, because:
39 |
40 |
41 | ### Lazy Evaluation
42 |
43 | Haskell is lazy:
44 | * Expressions are only evaluated when the result is needed
45 | * ... and only as far as needed!
46 | * Results are *memoized*, i.e. only computed once.
47 | * To be precise: Evaluation is driven by Pattern Matching.
48 |
49 | This allows for infinite constructs like repeat:
50 |
51 | ```haskell
52 | replicate 0 x = []
53 | replicate n x = x : replicate (n - 1) x
54 | ```
55 |
56 | The function creates a so-called »Thunk«, a reference to a computation to be
57 | executed:
58 |
59 | ╭───────────────╮
60 | │ replicate 2 x │
61 | ╰───────────────╯
62 |
63 | After matching on the first `Cons` cell, the memory is updated (memoization):
64 |
65 | ┌───┐ ╭───────────────╮
66 | │ x ├─│ replicate 1 x │
67 | └───┘ ╰───────────────╯
68 |
69 | ... and the second `Cons` cell:
70 |
71 | ┌───┐ ┌───┐ ╭───────────────╮
72 | │ x ├─│ x ├─│ replicate 0 x │
73 | └───┘ └───┘ ╰───────────────╯
74 |
75 | The next pattern-match finds the final `Nil` cell:
76 |
77 | ┌───┐ ┌───┐
78 | │ x ├─│ x ├───[]
79 | └───┘ └───┘
80 |
81 |
82 | ### Efficiency of Lists
83 |
84 | Lists are quite inefficient when compiled naively.
85 |
86 | But laziness allows **Stream Fusion**, which basically allows the compiler to
87 | rearrange and group list operations, so that often a list is never even written
88 | to memory, but produces and transform elements as they are consumed.
89 |
90 | ```haskell
91 | fac :: Int -> Int
92 | fac n = product [1..n]
93 | ```
94 |
95 | Q: How many memory allocations does `fac 100` perform?
96 |
97 | A: None at all: The numbers are produced incrementally, as they are consumed by
98 | `product`. No memory allocation required.
99 |
100 |
101 | ## How Lazy can you be?
102 |
103 | Assume the Java equivalent of the `head` function:
104 |
105 | ```java
106 | // public static A head(List list) { … }
107 |
108 | head(asList(f(100), f(200), f(300)))
109 | ```
110 |
111 | In what order are the calls evaluated?
112 |
113 | 1. Evaluate `f(100)`, `f(200)`, `f(300)`
114 | 2. Pass the result to `asList(•,•,•)`, evaluate
115 | 3. Pass the result to `head(•)`, evaluate
116 |
117 |
118 | ### Let's Procrastinate!
119 |
120 | ```haskell
121 | head :: [a] -> a
122 | head (a : as) = a
123 |
124 | head [f 100, f 200, f 300]
125 | ```
126 |
127 | In what order are the calls evaluated?
128 |
129 | 1. Enter head function, pass `[f 100, f 200, f 300]` as thunk
130 | 2. Encounter pattern `(a : as)`
131 | 3. Evaluate thunk to Weak Head Normal Form (WHNF: `• : •`)
132 | 4. Return `f 100` as thunk
133 |
134 | We didn't even once call `f`!
135 |
136 | (Now think what would happen for `f n = f (n-1) + f(n-2)` ...)
137 |
138 |
139 |
140 | ## Amortization
141 |
142 | For algorithms with varying cost per step, worst-case bounds can be too
143 | pessimistic, and the average case may not be an upper bound.
144 |
145 | Goal: Find a better upper bound by balancing between different cost centers.
146 |
147 |
148 | ### Example for amortization: Array Lists
149 |
150 | An Array List of fixed size `n` has `O(1)` insert.
151 |
152 | 7
153 | ↓
154 | ┌───┬───┬───┬───┬───┬───┬───┬───┐
155 | │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ │ │
156 | └───┴───┴───┴───┴───┴───┴───┴───┘
157 |
158 | But if the list is too small, the `n+1`st element takes `O(n)` to insert,
159 | because the entire list is copied to double the array size.
160 |
161 | ┌───┬───┬───┬───┬───┬───┬───┬───┐
162 | │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ 7 │ 8 │
163 | └───┴───┴───┴───┴───┴───┴───┴───┘ 9
164 | ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
165 | ┌───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┐
166 | │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ 7 │ 8 │ │ │ │ │ │ │ │ │
167 | └───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┘
168 |
169 | * Worst-case time for insert: `O(n)`
170 | * Amortized time for insert: `O(1)`!
171 |
172 |
173 | ### The banker's and the Physicist's method
174 |
175 | #### Banker's method:
176 |
177 | * Place credits at each location in the data structure.
178 | * Cheap operations may add credits (making them slightly more expensive).
179 | * Expensive operations may consume credits (making them possibly cheaper).
180 | * Credits can only be consumed after they have been placed, not in advance.
181 |
182 | The goal is to find an accounting scheme where each expensive operation is
183 | already paid for in credits.
184 |
185 | #### Physicist's method:
186 |
187 | * Define a potential `Φ` based on a property of each location.
188 | * The total potential is an upper bound for the accumulated savings, it must
189 | never be negative.
190 | * The amortized cost of an operation is the actual cost plus the change in
191 | potential:
192 | * Expensive operations can be made cheaper by drawing from the potential,
193 | * cheap operations can add to the potential.
194 |
195 | The goal is to find a good definition for the potential, so that it will never
196 | become negative, and so that expensive operations may draw from it.
197 |
198 | Both methods are equivalent:
199 | * Proofs using the Physicist's method are easier to write, because we can ignore
200 | the locations of the credits.
201 | * Proofs using the Banker's method are easier to understand, because we known
202 | when and where the credits are placed and consumed.
203 |
204 |
205 | ### Array List insertion: Amortized Analysis
206 |
207 | ┌───┬───┬───┬───┬───┬───┬───┬───┐
208 | │ 1*│ 2*│ 3 │ 4 │ 5*│ 6*│ │ │
209 | └───┴───┴───┴───┴───┴───┴───┴───┘
210 | ┌───┬───┬───┬───┬───┬───┬───┬───┐
211 | │ 1*│ 2*│ 3*│ 4 │ 5*│ 6*│ 7*│ │
212 | └───┴───┴───┴───┴───┴───┴───┴───┘
213 | ┌───┬───┬───┬───┬───┬───┬───┬───┐
214 | │ 1*│ 2*│ 3*│ 4*│ 5*│ 6*│ 7*│ 8*│
215 | └───┴───┴───┴───┴───┴───┴───┴───┘ 9
216 | ┌───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┐
217 | │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ 7 │ 8 │ │ │ │ │ │ │ │ │
218 | └───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┘
219 | ┌───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┬───┐
220 | │ 1*│ 2 │ 3 │ 4 │ 5 │ 6 │ 7 │ 8 │ 9*│ │ │ │ │ │ │ │
221 | └───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┴───┘
222 |
223 | Account three credits for inserting element `m` into a list of length `N`:
224 | * One paid directly for actually storing the element
225 | * One saved for copying it to the next larger array
226 | * One saved for copying element `m - 2^(N-1)` to the next larger array
227 |
228 | When reaching the size limit, we have exactly one credit per cell to be copied.
229 | In other words, the resizing operation has already been paid for!
230 |
231 | With a constant three credits per insert operation, we have constant-time
232 | insert.
233 |
234 |
235 | ### Haskell Example: Batched Queue
236 |
237 | ```haskell
238 | data Queue a = Queue [a] [a]
239 |
240 | check :: Queue a -> Queue a
241 | check (Queue write []) = Queue [] (reverse write)
242 | check queue = queue
243 |
244 | empty :: Queue a
245 | empty = Queue [] []
246 |
247 | insert :: a -> Queue a -> Queue a
248 | insert a (Queue write read) = check (Queue (a : write) read)
249 |
250 | view :: Queue a -> (a, Queue a)
251 | view (Queue write (a : read')) = (a, check (Queue write read'))
252 | ```
253 |
254 | Inserting an element always takes `O(1)`, but reversing the front end of the
255 | queue takes `O(n)`!
256 | => The worst-case complexity for `view` is `O(n)`.
257 |
258 | Can we do better?
259 |
260 |
261 | ### Amortization for Batched Queue
262 |
263 | Use the Banker's method:
264 |
265 | ┌───┐
266 | insert 1: [] │ 1 ├───[]
267 | └───┘
268 | ┌───┐ ┌───┐
269 | insert 2: │ 2*├───[] │ 1 ├───[]
270 | └───┘ └───┘
271 | ┌───┐ ┌───┐ ┌───┐
272 | insert 3: │ 3*├─│ 2*├───[] │ 1 ├───[]
273 | └───┘ └───┘ └───┘
274 | ┌───┐ ┌───┐
275 | view: [] │ 2 ├─│ 3 ├───[]
276 | └───┘ └───┘
277 | ┌───┐ ┌───┐ ┌───┐
278 | insert 4: │ 4*├───[] │ 2 ├─│ 3 ├───[]
279 | └───┘ └───┘ └───┘
280 | ┌───┐ ┌───┐
281 | view: │ 4*├───[] │ 3 ├───[]
282 | └───┘ └───┘
283 |
284 | * On `insert`, account one credit to each inserted item, to a total cost of 2.
285 | * `view` without reversing does not consume any credits, so the total cost is 1.
286 | * `view` with reversing costs `n+1` steps, consumes `n` credits, so the net
287 | total cost is 1.
288 |
289 | => Batched Queue has `O(1)` amortized `view` and `insert`.
290 |
291 | Does it really?
292 |
293 |
294 | ### Problem with Amortization: Persistence
295 |
296 | Immutable data structures are **persistent**, they can be reused. This breaks
297 | our accounting balance:
298 |
299 | ```haskell
300 | peek :: Queue a -> a
301 | peek q = case view q of (a, _) -> a
302 |
303 | enqueueHead queue = insert (peek queue) queue
304 | ```
305 |
306 | In order to `view` the first element, `peek` potentially reverses the list,
307 | spending all the saved credits, but immediately throws away the updated queue.
308 | Then `enqueueHead` continues with the old queue and `insert`s the result.
309 |
310 | If anyone `view`s the result of `enqueueHead`, the queue will be reversed
311 | *again* - but the credits have already been spent!
312 |
313 |
314 | ### Laziness and Amortization
315 |
316 | Idea: Use lazy evaluation, in particular memoization, to guarantee credits are
317 | only spent once.
318 |
319 | Lazy amortization using the Banker's method is a *layaway plan*:
320 |
321 | * Each time a thunk is created, we assign it a number of credits proportional to
322 | the time it takes to evaluate it.
323 | * We commit to save credits on each subsequent operation to pay for the
324 | evaluation.
325 | * Goal is to prove that in each possible future, there are enough saved credits
326 | to pay for the thunk when it is evaluated.
327 |
328 |
329 |
330 | ## Banker's Queue
331 |
332 | ```haskell
333 | data Queue a = Queue
334 | { lenWrite :: !Int
335 | , write :: [a]
336 | , lenRead :: !Int
337 | , read :: [a] }
338 |
339 | check :: Queue a -> Queue a
340 | check queue@(Queue {..})
341 | | lenWrite > lenRead = Queue 0 [] (lenRead + lenWrite) (read ++ reverse write))
342 | | otherwise = queue
343 |
344 | empty :: Queue a
345 | empty = Queue 0 [] 0 []
346 |
347 | insert :: a -> Queue a -> Queue a
348 | insert a (Queue {..}) = check (Queue (lenWrite + 1) (a : write) lenRead read)
349 |
350 |
351 | view :: Queue a -> (a, Queue a)
352 | view (Queue {..}) = case read of
353 | [] -> error "Empty queue"
354 | a : read' -> (a, check (Queue lenWrite write (lenRead - 1) read'))
355 | ```
356 |
357 |
358 | ### Amortization for Banker's Queue
359 |
360 | ┌───┐
361 | insert 1: [] │ 1 ├───[]
362 | └───┘
363 | ┌───┐ ┌───┐
364 | insert 2: │ 2 ├───[] │ 1 ├───[]
365 | └───┘ └───┘
366 | ┌───┐ ╭───────────────────╮
367 | insert 3: [] │ 1 ├─│ ** reverse [3, 2] │
368 | └───┘ ╰───────────────────╯
369 | ╭──────────────────╮
370 | view: [] │ * reverse [3, 2] │
371 | ╰──────────────────╯
372 | ┌───┐ ╭──────────────────╮
373 | insert 4: │ 4 ├───[] │ * reverse [3, 2] │
374 | └───┘ ╰──────────────────╯
375 | ┌───┐ ┌───┐
376 | view: │ 4 ├───[] │ 3 ├───[]
377 | └───┘ └───┘
378 |
379 | #### `insert`:
380 |
381 | * Trivial `insert` takes one credit
382 | * `insert` with `reverse` takes one credit, and creates a thunk with `lenWrite`
383 | credits
384 |
385 | => `insert` runs in `O(1)`
386 |
387 | #### `view`:
388 |
389 | * `view` costs one credit, and we save one credit to pay for the next thunk.
390 | * Condition for rotating the queue: `lenWrite > lenRead`. => When reaching the
391 | thunk of a `reverse` operation, we have saved at least `lenRead` credits to
392 | pay for the thunk.
393 |
394 | => `view` runs in amortized `O(1)`
395 |
396 |
397 | ### Constant Overhead
398 |
399 | The Banker's Queue is slightly slower than the Batched Queue because of the
400 | additional book-keeping. Hence, in reality the Batched Queue is preferred where
401 | possible.
402 |
403 | Example: `Control.Concurrent.STM.TQueue` from `stm` uses a Batched Queue, since
404 | the queue is not used persistently, but ephemerally.
405 |
406 |
407 |
408 | ## Finger Trees
409 |
410 | [Ralf Hinze and Ross Paterson, »Finger trees: a simple general-purpose data
411 | structure«, Journal of Functional Programming 16:2 (2006).
412 | ](http://www.staff.city.ac.uk/~ross/papers/FingerTree.pdf)
413 |
414 | Used in: `Data.Sequence`
415 |
416 | FingerTree a • 1..8 items
417 | ┌─┬─┬─┬───┼───┬─┬─┐
418 | a b c d │ X Y Z
419 | │
420 | FingerTree (Node a) │ 2..24 items
421 | ┌───────┬───────┬─────┼─────┬──────┐
422 | ┌─┼─┐ ┌─┼─┐ ┌─┼─┐ │ ┌─┼─┐ ┌┴┐
423 | e f g h i j k l m │ S T U V W
424 | │
425 | FingerTree (Node (Node a)) │ 4..72 items
426 | ┌───────────────┬───────┼─────────┐
427 | ┌──────┼──────┐ ┌──┴──┐ │ ┌───┴───┐
428 | ┌─┼─┐ ┌┴┐ ┌┴┐ ┌┴┐ ┌┴┐ │ ┌─┼─┐ ┌─┼─┐
429 | n o p q r s t u v w x │ M N O P Q R
430 | │
431 | FingerTree (Node (Node (Node a))) │ 8..216 items
432 | ┌────────────┼────────────┐
433 | ┌──┴──┐ ┌───┴──┐ ┌──┴───┐
434 | ┌┴┐ ┌┴┐ ┌┴┐ ┌─┼─┐ ┌┴┐ ┌─┼─┐
435 | y z A B C D E F G H I J K L
436 |
437 |
438 | ### Finger Tree: Data Types
439 |
440 | ```haskell
441 | data FingerTree a
442 | = Empty
443 | | Single a
444 | | Deep !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
445 |
446 | data Digit a = One a | Two a a | Three a a a | Four a a a a
447 |
448 | data Node a = Node2 a a | Node3 a a a
449 |
450 | class Sized a where
451 | size :: Int
452 |
453 | instance Sized a => Sized (FingerTree a)
454 | instance Sized a => Sized (Digit a)
455 | instance Sized a => Sized (Node a)
456 | ```
457 |
458 |
459 | ### Finger Tree: Inserting Elements
460 |
461 | ```haskell
462 | (<|) -- `cons`
463 | :: Sized a => a -> FingerTree a -> FingerTree a
464 | (|>) -- `snoc` (`cons` backwards)
465 | :: Sized a => FingerTree a -> a -> FingerTree a
466 |
467 | a <| Single b = Deep (One a) Empty (One b)
468 | a <| Deep s l t r = case l of
469 | One b -> Deep s' (Two a b) t r
470 | Two b c -> Deep s' (Three a b c) t r
471 | Three b c d -> Deep s' (Four a b c d) t r
472 | Four b c d e -> t `seq` -- Push a node down the spine
473 | Deep s' (Two a b) (Node3 c d e <| t) r
474 | where s' = s + size a
475 | ```
476 |
477 |
478 | ### Building a Tree
479 |
480 | 1 <| 2 <| 3 <| 4 <| 5 <| 6 <| 7 <| 8 <| 9 <| Empty
481 |
482 |
483 | 1 <| 2 <| 3 <| 4 <| 5 <| 6 <| 7 <| 8 <| Single 9
484 |
485 | •
486 | |
487 | 9
488 |
489 |
490 | 1 <| 2 <| 3 <| 4 <| 5 <| 6 <| 7 <| Deep (One 8) Empty (One 9)
491 |
492 | •
493 | ┌───┴───┐
494 | 8 9
495 |
496 | `Single` is split into a `Deep` tree with `One` on each side and `Empty` spine.
497 |
498 |
499 | 1 <| 2 <| 3 <| 4 <| 5 <| 6 <| Deep (Two 7 8) Empty (One 9)
500 |
501 | •
502 | ┌─┬───┴───┐
503 | 7 8 9
504 |
505 |
506 | 1 <| 2 <| 3 <| 4 <| 5 <| Deep (Three 6 7 8) Empty (One 9)
507 |
508 | •
509 | ┌─┬─┬───┴───┐
510 | 6 7 8 9
511 |
512 |
513 | 1 <| 2 <| 3 <| 4 <| Deep (Four 5 6 7 8) Empty (One 9)
514 |
515 | •
516 | ┌─┬─┬─┬───┴───┐
517 | 5 6 7 8 9
518 |
519 | Elements are inserted into the left `Digit` until it reaches `Four`.
520 |
521 |
522 | 1 <| 2 <| 3 <| Deep (Two 4 5) (Single (Node3 6 7 8)) (One 9)
523 |
524 | •
525 | ┌─┬───┼───┐
526 | 4 5 │ 9
527 | ┌─┼─┐
528 | 6 7 8
529 |
530 | When the left `Digit` is full, three elements are pushed down the spine as a
531 | `Single Node3`, leaving `Two` on the left `Digit`.
532 |
533 |
534 | 1 <| 2 <| Deep (Three 3 4 5) (Single (Node3 6 7 8)) (One 9)
535 |
536 | •
537 | ┌─┬─┬───┼───┐
538 | 3 4 5 │ 9
539 | ┌─┼─┐
540 | 6 7 8
541 |
542 | Now we can insert two more elements into the left `Digit`.
543 |
544 | 1 <| Deep (Four 2 3 4 5) (Single (Node3 6 7 8)) (One 9)
545 |
546 | •
547 | ┌─┬─┬─┬───┼───┐
548 | 2 3 4 5 │ 9
549 | ┌─┼─┐
550 | 6 7 8
551 |
552 |
553 | Deep (Two 1 2) (Deep (One (Node3 3 4 5)) Empty (One (Node3 6 7 8))) (One 9)
554 |
555 | •
556 | ┌─┬───┼───┐
557 | 1 2 │ 9
558 | ┌───┴───┐
559 | ┌─┼─┐ ┌─┼─┐
560 | 3 4 5 6 7 8
561 |
562 | One more `Node3` is pushed down the spine, recursively splitting the `Single`
563 | into a `Deep` with two `One`s of `Node3`s.
564 |
565 |
566 |
567 | * `<|` tries to pack as tighly as possible (always creates `Node3`)
568 | * Always keeps two elements on either side, if possible (for fast `view`)
569 | * `|>` works exactly the same
570 |
571 |
572 | ### Finger Tree: Decomposition
573 |
574 | ```haskell
575 | viewL :: Sized a => FingerTree a -> Maybe (a, FingerTree a)
576 | viewR :: Sized a => FingerTree a -> Maybe (FingerTree a, a)
577 |
578 | viewL Empty = Nothing
579 |
580 | viewL (Single a) = Just (a, Empty)
581 |
582 | viewL (Deep s l t r) = Just $ case l of
583 | Four a b c d -> (a, Deep (s - size a) (Three b c d) t r)
584 | Three a b c -> (a, Deep (s - size a) (Two b c) t r)
585 | Two a b -> (a, Deep (s - size a) (One b) t r)
586 |
587 | One a -> case viewL t of -- Pull a node up from the spine
588 | Just (Node3 b c d, t') -> (a, Deep (s - size a) (Three b c d) t' r)
589 | Just (Node2 b c, t') -> (a, Deep (s - size a) (Two b c) t' r)
590 |
591 | Nothing -> case r of -- If the spine is empty, balance with the right digit
592 | Four b c d e -> (a, Deep (s - size a) (Two b c) Empty (Two d e))
593 | Three b c d -> (a, Deep (s - size a) (Two b c) Empty (One d))
594 | Two b c -> (a, Deep (s - size a) (One b) Empty (One c))
595 | One b -> (a, Single b)
596 | ```
597 |
598 |
599 | ### Viewing or Deleting Elements from a Tree
600 |
601 | Deep (Two 1 2) (Deep (One (Node3 3 4 5)) Empty (One (Node3 6 7 8))) (Two 9 10)
602 |
603 | •
604 | ┌─┬───┼───┬─┐
605 | 1 2 │ 9 10
606 | ┌───┴───┐
607 | ┌─┼─┐ ┌─┼─┐
608 | 3 4 5 6 7 8
609 |
610 |
611 | Deep (One 2) (Deep (One (Node3 3 4 5)) Empty (One (Node3 6 7 8))) (Two 9 10)
612 |
613 | •
614 | ┌───┼───┬─┐
615 | 2 │ 9 10
616 | ┌───┴───┐
617 | ┌─┼─┐ ┌─┼─┐
618 | 3 4 5 6 7 8
619 |
620 |
621 | Deep (Three 3 4 5) (Single (Node3 6 7 8)) (Two 9 10)
622 |
623 | •
624 | ┌─┬─┬───┼───┬─┐
625 | 3 4 5 │ 9 10
626 | ┌─┼─┐
627 | 6 7 8
628 |
629 | If the left `Digit` would become empty, recursively fetch a `Node` from the spine.
630 |
631 |
632 | Deep (Two 4 5) (Single (Node3 6 7 8)) (Two 9 10)
633 |
634 | •
635 | ┌─┬───┼───┬─┐
636 | 4 5 │ 9 10
637 | ┌─┼─┐
638 | 6 7 8
639 |
640 |
641 | Deep (One 5) (Single (Node3 6 7 8)) (Two 9 10)
642 |
643 | •
644 | ┌───┼───┬─┐
645 | 5 │ 9 10
646 | ┌─┼─┐
647 | 6 7 8
648 |
649 |
650 | Deep (Three 6 7 8) Empty (Two 9 10)
651 |
652 | •
653 | ┌─┬─┬───┴───┬─┐
654 | 6 7 8 9 10
655 |
656 | Fetch one more `Node` from the sping, leaving the spine `Empty`.
657 |
658 |
659 | Deep (Two 7 8) Empty (Two 9 10)
660 |
661 | •
662 | ┌─┬───┴───┬─┐
663 | 7 8 9 10
664 |
665 |
666 | Deep (One 8) Empty (Two 9 10)
667 |
668 | •
669 | ┌───┴───┬─┐
670 | 8 9 10
671 |
672 |
673 | Deep (One 9) Empty (One 10)
674 |
675 | •
676 | ┌───┴───┐
677 | 9 10
678 |
679 | If the spine is empty, try to fetch nodes from the right.
680 |
681 | Single 10
682 |
683 | •
684 | │
685 | 10
686 |
687 |
688 | * Never leaves four elements on either side, for fast subsequent `<|`.
689 | * `viewR` works exactly the same.
690 |
691 | `viewL` performs in amortized `O(1)`.
692 |
693 |
694 | ### Finger Tree: Amortization
695 |
696 | * Rewriting a `Deep` with its (strict) `Digit`s costs one credit.
697 | * Every access to the spine (push down/pull up) costs one credit.
698 |
699 | Access to the spine only happens for `One` and `Four`. Those `Digit`s are called
700 | *dangerous*, the others are *safe*.
701 |
702 | Note that every access to a dangerous digit makes it safe:
703 | * Adding/removing elements: `One` -> `Two`, `Four` -> `Three`
704 | * Accessing the spine: `One` -> `Three`/`Two`, `Four` -> `Two`
705 |
706 |
707 | ### Finger Tree: Layaway plan
708 |
709 | #### Pushing a node down the spine:
710 |
711 | * Costs one credit for writing the `Two`.
712 | * Each recursion creates a thunk that will eventually cost one credit.
713 | * Each recursion turns a dangerous digit into a safe one.
714 |
715 | #### Pulling a node from the spine:
716 |
717 | * Accessing the `Digit` costs one credit.
718 | * Each recursion forces a thunk in the spine, which must already be paid for.
719 | * Each recursion turns a dangerous digit into a safe one.
720 |
721 | #### Layaway Plan
722 |
723 | Charge two credits per `cons` and `viewL`: One to rewrite the `Digit`, and one
724 | to pay the debt of a spine thunk.
725 |
726 | **Invariant:** Every time a digit becomes dangerous, the debt for the spine
727 | thunk is resolved.
728 |
729 | Inductive proof:
730 | * **Step:** When recursing down the spine, assuming its debt has been paid, we
731 | use our extra credit to pay for the spine of the first safe `Digit` we
732 | encounter. All the `Digit`s on the way are now safe.
733 | * **Initial:** When creating a spine, we immediately use the extra credit to
734 | resolve its debt.
735 |
736 | => Spines of dangerous `Digit`s are guaranteed to be paid for, spines of safe
737 | `Digit`s may have open debt.
738 |
739 | => Each time we access the spine, the debt has already been paid!
740 |
741 |
742 | ### Finger Tree: Splitting and appending
743 |
744 | #### Splitting
745 |
746 | `split :: Sized a => Int -> FingerTree a -> (FingerTree a, FingerTree a)` uses
747 | the size annotation to decide which subtree/digit/node to split.
748 |
749 | `O(log n)`: On each level, we create two digits and two lazy spines.
750 |
751 | #### Merging
752 |
753 | `merge :: FingerTree a -> FingerTree a -> FingerTree a` creates `Node`s from
754 | adjacent `Digit`s and pushes them up the spine.
755 |
756 | `O(log n)`: On each level, we merge two digits, and push at most four nodes up
757 | the spine.
758 |
759 | #### Random Access
760 |
761 | `lookup :: Sized a => Int -> FingerTree a -> Maybe a` looks up the `i`-th
762 | element by splitting the tree at `i` and returning the minimum element of the
763 | right tree.
764 |
765 | `O(log n)`: It's just a `split` plus a constant time operation.
766 |
767 |
768 | ### Finger Tree: Applications
769 |
770 | * Sequences (`Data.Sequence`), Queues: `O(log n)` random access, `O(1)` access to
771 | both ends, O(log n) `append`.
772 |
773 | * (Fair) Priority Queues: Replace the Size annotation by a Priority annotation.
774 | `O(1)` insert and `O(log n)` access to the minimum element.
775 |
776 |
777 | ## Other Widely-Used Functional Data Structures
778 |
779 | ### Size-Balanced Binary Trees
780 |
781 | Used in `Data.Set` and `Data.Map` in `containers`.
782 |
783 | * `Map`s (`Set`s) use the `Ord` instance of the keys (elements) to maintain
784 | ordering for `O(log n)` worst-case insert and lookup.
785 | * To prevent degeneration to `O(n)` in pathological cases, two subtrees are
786 | rebalanced if their sizes differ by a factor greater than 3.
787 |
788 | ```haskell
789 | data Map k v
790 | = Bin { size :: !Int
791 | , key :: !k
792 | , root :: v
793 | , left :: !(Map k v)
794 | , right :: !(Map k v) }
795 | | Tip
796 | ```
797 |
798 | ### Skew Binomial Heaps
799 |
800 | Used in `Data.Heap` in Edward Kmett's `heaps`.
801 |
802 | * A variant of Binomaial Heaps with worst-case instead of amortized bounds.
803 | * Used as Priority Queues
804 | * Same asymptotic bounds as Finger Trees, slightly faster, but not stable (fair).
805 |
806 | ```haskell
807 | data Heap a
808 | = Empty
809 | | Tree { rank :: !Int
810 | , root :: a
811 | , forest :: [Heap a]
812 | -- ^ Zero or one tree of each rank smaller than this tree's rank,
813 | -- ordered by increasing rank. First two trees may have the same rank,
814 | -- to limit number of carries per operation.
815 | }
816 | ```
817 |
818 |
819 |
820 | ## Conclusion
821 |
822 | * Immutability does not prevent efficient data structures.
823 | * Smart compilers make stupid programs run fast.
824 | * Being lazy can save you a lot of work.
825 |
826 |
827 |
828 | ## Thank you!
829 |
--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 |
--------------------------------------------------------------------------------
/stack.yaml:
--------------------------------------------------------------------------------
1 | # This file was automatically generated by 'stack init'
2 | #
3 | # Some commonly used options have been documented as comments in this file.
4 | # For advanced use and comprehensive documentation of the format, please see:
5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/
6 |
7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version.
8 | # A snapshot resolver dictates the compiler version and the set of packages
9 | # to be used for project dependencies. For example:
10 | #
11 | # resolver: lts-3.5
12 | # resolver: nightly-2015-09-21
13 | # resolver: ghc-7.10.2
14 | # resolver: ghcjs-0.1.0_ghc-7.10.2
15 | # resolver:
16 | # name: custom-snapshot
17 | # location: "./custom-snapshot.yaml"
18 | resolver: lts-8.4
19 |
20 | # User packages to be built.
21 | # Various formats can be used as shown in the example below.
22 | #
23 | # packages:
24 | # - some-directory
25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz
26 | # - location:
27 | # git: https://github.com/commercialhaskell/stack.git
28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
30 | # extra-dep: true
31 | # subdirs:
32 | # - auto-update
33 | # - wai
34 | #
35 | # A package marked 'extra-dep: true' will only be built if demanded by a
36 | # non-dependency (i.e. a user package), and its test suites and benchmarks
37 | # will not be run. This is useful for tweaking upstream packages.
38 | packages: []
39 |
40 | # Dependency packages to be pulled from upstream that are not in the resolver
41 | # (e.g., acme-missiles-0.3)
42 | extra-deps: []
43 |
44 | # Override default flag values for local packages and extra-deps
45 | flags: {}
46 |
47 | # Extra package databases containing global packages
48 | extra-package-dbs: []
49 |
50 | # Control whether we use the GHC we find on the path
51 | # system-ghc: true
52 | #
53 | # Require a specific version of stack, using version ranges
54 | # require-stack-version: -any # Default
55 | # require-stack-version: ">=1.3"
56 | #
57 | # Override the architecture used by stack, especially useful on Windows
58 | # arch: i386
59 | # arch: x86_64
60 | #
61 | # Extra directories used by stack for building
62 | # extra-include-dirs: [/path/to/dir]
63 | # extra-lib-dirs: [/path/to/dir]
64 | #
65 | # Allow a newer minor version of GHC than the snapshot specifies
66 | # compiler-check: newer-minor
67 |
--------------------------------------------------------------------------------