class (Functor s, MonadPlus s) => Sequence sAll sequences are also instances of Functor, Monad, and MonadPlus. In addition, all sequences are expected to be instances of Eq and Show, although this is not enforced (in fact, is not enforceable in any reasonable way).
Sequence Methods
- Constructors:
empty, single, cons, snoc, append, fromList, copy, tabulate
- Destructors:
lview, lhead, ltail, rview, rhead, rtail
- Observers:
null, size, toList
- Concat and reverse:
concat, reverse, reverseOnto
- Maps and folds:
map, concatMap, foldr, foldl, foldr1, foldl1, reducer, reducel, reduce1
- Subsequences:
take, drop, splitAt, subseq
- Predicate-based operations:
filter, partition, takeWhile, dropWhile, splitWhile
- Index-based operations:
inBounds, lookup, lookupM, lookupWithDefault, update, adjust,
mapWithIndex, foldrWithIndex, foldlWithIndex
- Zips and unzips:
zip, zip3, zipWith, zipWith3, unzip, unzip3, unzipWith, unzipWith3
Figure 5.1: Summary of methods for the Sequence class.
single x º cons x empty º snoc empty x |
cons x xs º append (single x) xs |
snoc xs x º append xs (single x) |
append xs ys º foldr cons ys xs |
fromList xs º foldr cons empty xs |
n > 0 -- copy n x º cons x (copy (n-1) x) |
n <= 0 -- copy n x º empty |
n > 0 -- tabulate n f º map f (fromList [0..n-1]) |
n <= 0 -- tabulate n f º empty |
lview empty º Nothing2 |
lview (cons x xs) º Just2 x xs |
lhead empty º error |
lhead (cons x xs) º x |
ltail empty º empty |
ltail (cons x xs) º xs |
rview empty º Nothing2 |
rview (snoc xs x) º Just2 xs x |
rhead empty º error |
rhead (snoc xs x) º x |
rtail empty º empty |
rtail (snoc xs x) º xs |
null xs º (size xs == 0) |
size empty º 0 |
size (cons x xs) º 1 + size xs |
toList empty º [] |
toList (cons x xs) º x : toList xs |
concat xss º foldr append empty xss |
reverse empty º empty |
reverse (cons x xs) º snoc (reverse xs) x |
reverseOnto xs ys º append (reverse xs) ys |
map f empty º empty |
map f (cons x xs) º cons (f x) (map f xs) |
concatMap f xs º concat (map f xs) |
foldr f c empty º c |
foldr f c (cons x xs) = f x (foldr f c xs) |
foldl f c empty º c |
foldl f c (cons x xs) = foldl f (f c x) xs |
foldr1 f empty º error |
foldr1 f (snoc xs x) º foldr f x xs |
foldl1 f empty º error |
foldl1 f (cons x xs) º foldl f x xs |
(a Å b) Å ((c Å d) Å (e Å f)) |
((a Å b) Å (c Å d)) Å (e Å f) |
(a Å (b Å c)) Å (d Å (e Å f)) |
((a Å b) Å c) Å ((d Å e) Å f) |
mergesort :: (Ord a,Sequence s) => s a -> s a mergesort xs = reducer merge empty (map single xs)Axioms:
reduce1 (Å) empty º error |
" x,y,z. x Å (y Å z) º (x Å y) Å z -- |
reduce1 (Å) xs º foldr1 (Å) xs º foldl1 (Å) xs |
reducer (Å) c xs º foldr (Å) c xs |
reducel (Å) c xs º foldl (Å) c xs |
i < 0 -- take i xs º empty |
i > size xs -- take i xs º xs |
size xs == i -- take i (append xs ys) º xs |
i < 0 -- drop i xs º xs |
i > size xs -- drop i xs º empty |
size xs == i -- drop i (append xs ys) º ys |
splitAt i xs º (take i xs, drop i xs) |
subseq i len xs º take len (drop i xs) |
filter p empty º empty |
filter p (cons x xs) º if p x then cons x (filter p xs) else filter p xs |
partition p xs º (filter p xs, filter (not . p) xs) |
takeWhile p empty º empty |
takeWhile p (cons x xs) º if p x then cons x (takeWhile p xs) else empty |
dropWhile p empty º empty |
dropWhile p (cons x xs) º if p x then dropWhile p xs else cons x xs |
splitWhile p xs º (takeWhile p xs, dropWhile p xs) |
inBounds xs i º (0 <= i && i < size xs) |
not (inBounds xs i) -- lookup xs i º error |
size xs == i -- lookup (append xs (cons x ys)) i º x |
not (inBounds xs i) -- lookupM xs i º Nothing |
size xs == i -- lookupM (append xs (cons x ys)) i º Just x |
not (inBounds xs i) -- lookupWithDefault d xs i º d |
size xs == i -- lookupWithDefault d (append xs (cons x ys)) i º x |
not (inBounds xs i) -- update i y xs º xs |
size xs == i -- update i y (append xs (cons x ys)) º append xs (cons y ys) |
not (inBounds xs i) -- adjust f i xs º xs |
size xs == i -- adjust f i (append xs (cons x ys)) º append xs (cons (f x) ys) |
mapWithIndex f empty º empty |
mapWithIndex f (snoc xs x) º snoc (mapWithIndex f xs) (f (size xs) x) |
foldrWithIndex f c empty º c |
foldrWithIndex f c (snoc xs x) º foldrWithIndex f (f (size xs) x c) xs |
foldlWithIndex f c empty º c |
foldlWithIndex f c (snoc xs x) º f (foldlWithIndex f c xs) (size xs) x |
zip xs ys º zipWith (l x y ® (x,y)) xs ys |
zip3 xs ys zs º zipWith3 (l x y z ® (x,y,z)) xs ys zs |
zipWith f (cons x xs) (cons y ys) º cons (f x y) (zipWith f xs ys) |
(null xs Ú null ys) -- zipWith f xs ys º empty |
zipWith3 f (cons x xs) (cons y ys) (cons z zs) º cons (f x y z) (zipWith3 f xs ys zs) |
(null xs Ú null ys Ú null zs) -- zipWith3 f xs ys zs º empty |
unzip xys º (map fst xys, map snd xys) |
unzip3 xyzs º (map fst3 xyzs, map snd3 xyzs, map thd3 xyzs) |
unzipWith f g xs º (map f xs, map g xs) |
unzipWith3 f g h xs º (map f xs, map g xs, map h xs) |