> module SequenceUtilities
> (allEqual,
> apply,
> blocks,
> blocksRigid,
> centerInField,
> concatWithSpacer,
> decreasing,
> decreasingStrictly,
> dropFromRight,
> dropWhileFromRight,
> increasing,
> increasingStrictly,
> indicesOfOccurence,
> leftJustifyWith,
> monotonic,
> multiplex,
> packets,
> pam,
> prefixes,
> quicksort,
> quicksortWith,
> reps,
> rightJustifyWith,
> splitFromRight,
> suffixes,
> takeFromRight,
> takeUntil,
> takeWhileFromRight,
> transpose)
> where

group elements of sequence in blocks of given size
Note: For any sequence xs, n::Int with n > 0,
concat(blocks n xs) = xs

> blocks :: Int -> [a] -> [ [a] ]
> blocks blockSize =
>   takeWhile(not . null) . map fst .
>       iterate(splitAt blockSize . snd) . splitAt blockSize


group elements of sequence in blocks of given size
pad last group if necessary to make it the right length

> blocksRigid :: Int -> a -> [a] -> [ [a] ]
> blocksRigid blockSize pad =
>   map(leftJustifyWith pad blockSize) . blocks blockSize


package sequence into subsequences terminated by delimiter;
if xs is x1 ++ [d1] ++ x2 ++ [d2] ++ ... ++ xn ++ [dn] or
if xs is x1 ++ [d1] ++ x2 ++ [d2] ++ ... ++ xn
where each d satisfies (isDelimiter d),
and no element e of any x-i satisifies
(isDelimiter e)
then (packets xs) is [x1, x2, ..., xn]

> packets :: (a -> Bool) -> [a] -> [[a]]
> packets isDelimiter =
>   map fst . takeWhile(not . and . map null . pam[fst, snd]) .
>       iterate(break isDelimiter . drop 1 . snd) . break isDelimiter


multiplex a sequence of streams into one stream
using round-robin alternation among streams with elements remaining
Note: if s and t are different elements of the argument of multiplex
and length(s) >= length(t), then the delivered sequence contains
an element from s between each succesive element from t
Example: multiplex["abc", "12345", "wxyz"] = "a1wb2xc3y4z5"

> multiplex :: [[a]] -> [a]
> multiplex = concat . foldr multiInsert [ ]


insert elements of the first argument as initial elements of the
sequences in the second argument

> multiInsert :: [a] -> [[a]] -> [[a]]
> multiInsert xs yss = matchingPairs ++ tailOfLongerOne
>   where
>   matchingPairs = zipWith (:) xs yss
>   tailOfLongerOne = (map(:[ ]) . drop n) xs ++ drop n yss
>   n = length matchingPairs


prefixes delivers all of the non-empty prefixes of its argument:
prefixes [x1, x2, x3, ...] = [[x1], [x1, x2], [x1, x2, x3], ... ]

> prefixes :: [a] -> [[a]]
> prefixes = drop 1 . scanl (++) [ ] . map(:[ ])


suffixes delivers all of the non-empty suffixes of its argument:
suffixes [x1, x2, x3, ...] = [[x1, x2, x3, ...],
[x2, x3, ...],
[x3, ...],
... ]

> suffixes :: [a] -> [[a]]
> suffixes = takeWhile(not . null) . iterate(drop 1)


find indices in a sequence where an item occurs

> indicesOfOccurence :: Eq a => a -> [a] -> [Int]
> indicesOfOccurence item items =
>   foldr addIndex [] (zip items [0..])
>   where
>   addIndex (x,index) indexes
>       | x == item = [index] ++ indexes
>       | otherwise = indexes


justify a sequence in a field of a given width
(deliver original sequence if given field-width is too narrow)

> leftJustifyWith, rightJustifyWith, centerInField ::
>   a -> Int -> [a] -> [a]
> leftJustifyWith pad fieldWidth xs =
>   xs ++ reps (max 0 (fieldWidth - length xs)) pad
> rightJustifyWith pad fieldWidth xs =
>   reps (max 0 (fieldWidth - length xs)) pad ++ xs
> centerInField pad width xs =
>   reps leftPadLength pad ++ xs ++ reps rightPadLength pad
>   where
>   leftPadLength = max 0 ((width - lengthOfSequence) `div` 2)
>   rightPadLength
>       = max 0 (width - (leftPadLength + lengthOfSequence))
>   lengthOfSequence = length xs


form a sequence consisting of n copies of a given element

> reps :: Int -> a -> [a]
> reps n = take n . repeat


shortest prefix of a sequence containing an element
that satisfies a given predicate

> takeUntil :: (a -> Bool) -> [a] -> [a]
> takeUntil predicate xs = prePredicate ++ take 1 others
>   where
>   (prePredicate, others) = break predicate xs


from-the-right versions of take, drop, and split

> takeFromRight, dropFromRight :: Int -> [a] -> [a]
> takeWhileFromRight, dropWhileFromRight ::
>   (a -> Bool) -> [a] -> [a]
> splitFromRight :: Int -> [a] -> ([a], [a])
> takeFromRight n xs = drop (max 0 (length xs - n)) xs
> dropFromRight n xs = take (max 0 (length xs - n)) xs
> splitFromRight n xs = splitAt (max 0 (length xs - n)) xs
> takeWhileFromRight p = reverse . takeWhile p . reverse
> dropWhileFromRight p = reverse . dropWhile p . reverse


concatenate, but include a standard element between appendees
Note: if ws::[String], then concatWithSpacer " " ws = unwords ws

> concatWithSpacer :: [a] -> [[a]] -> [a]
> concatWithSpacer spacer [ ] = [ ]
> concatWithSpacer spacer nonEmptyList@(x : xs) =
>   foldr1 insertSpacer nonEmptyList
>   where
>   insertSpacer x1 x2 = x1 ++ spacer ++ x2


apply a function to an argument

> apply :: (a -> b) -> a -> b
> apply f x = f x


dual of map: apply sequence of functions to argument

> pam :: [a -> b] -> a -> [b]
> pam fs x = zipWith apply fs (repeat x)


arrange sequence elements in increasing order

> quicksort :: Ord a => [a] -> [a]
> quicksort (firstx : xs) =
>   quicksort[x | x <- xs, x < firstx] ++ [firstx] ++
>   quicksort[x | x <- xs, not(x < firstx)]
> quicksort [ ] = [ ]


arrange sequence elements in order according to given ordering

> quicksortWith :: (a -> a -> Bool) -> [a] -> [a]
> quicksortWith precedes (firstx : xs) =
>   quicksortWith precedes [x | x <- xs, precedes x firstx] ++
>   [firstx] ++
>   quicksortWith precedes [x | x <- xs, not(precedes x firstx)]
> quicksortWith precedes [ ] = [ ]


check to see if a sequence is monotonic wrt a given transitive relation

> monotonic :: (a -> a -> Bool) -> [a] -> Bool
> monotonic precedes xs = (and . zipWith precedes xs . drop 1) xs


check to see if a sequence is increasing, decreasing, or flat

> allEqual :: Eq a => [a] -> Bool
> increasing, increasingStrictly,
>   decreasing, decreasingStrictly :: Ord a => [a] -> Bool
> allEqual = monotonic(==)
> increasing = monotonic(<=)
> increasingStrictly = monotonic(<)
> decreasing = monotonic(>=)
> decreasingStrictly = monotonic(>)


interchange rows and columns in a column of rows;
the i-th element of the j-th sequence of the delivered result
is the j-th element of the i-th sequence of the argument
Note: successive rows may decrease in length;
that is, transpose works properly on upper-triangular matrices

> transpose :: [[a]] -> [[a]]
> transpose = foldr patchRowAcrossColumns [ ]
>   where
>   patchRowAcrossColumns row columns =
>       zipWith (:) row (columns ++ repeat [ ])