\subsection{Utility functions}

\begin{haskelllisting}

> module Haskore.General.Utility(
>         fst3, snd3, thd3, mapPair, mapFst, mapSnd, flipPair,
>         flattenTuples2, flattenTuples3, flattenTuples4,
>         mergeBy, partition, splitBy, segmentBefore,
>         shuffle, removeDups, foldrf,
>         roundDiff, roundDiff',
>         mapInit, splitInit, headWithDefault,
>         zapWith, zipWithMatch, zipWithMatch3,
>         maximum0, maximumKey, minimumKey,
>         limit, translate, randList, select,
>         equalField, equalRecord,
>         compareField, compareRecord, composeDouble,
>         divisible, divide, modulus, divideModulus, gcdDur,
>         toMaybe, partitionMaybe
> 	) where
> 
> import Control.Monad.State (State(State), runState)
> import System.Random(RandomGen, randomR, randomRs, mkStdGen)
> import Data.List (group, find, foldl', maximumBy, minimumBy)
> import Data.Ratio((%), denominator, numerator, Ratio)
> import Data.Maybe (fromMaybe, listToMaybe)
> import qualified Haskore.General.Map as Map


\end{haskelllisting}

Support for triples.

\begin{haskelllisting}

> fst3 :: (a,b,c) -> a
> fst3 (x,_,_) = x

> snd3 :: (a,b,c) -> b
> snd3 (_,x,_) = x

> thd3 :: (a,b,c) -> c
> thd3 (_,_,x) = x

\end{haskelllisting}

Given two lists that are ordered
(i.e. \lstinline!p x y! holds for subsequent \code{x} and \code{y})
mergeBy them into a list that is ordered, again.

This could be used for parallel compositions of \code{Performance.T}
if the events had absolute times.

\begin{haskelllisting}

> mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
> mergeBy p =
>    let recurse xl@(x:xs) yl@(y:ys) =
>          if p x y then x : recurse xs yl
>                   else y : recurse xl ys
>        recurse [] yl = yl
>        recurse xl [] = xl
>    in  recurse

\end{haskelllisting}

\code{List.partition} of GHC 6.2.1 fails on infinite lists.
But this one does not.
The strict evaluation of the argument \code{(y,z)} is necessary
since otherwise it fails on infinite lists.

\begin{haskelllisting}

> partition :: (a -> Bool) -> [a] -> ([a], [a])
> partition p =
>    foldr (\x ~(y,z) -> if p x then (x : y, z)
>                               else (y, x : z)) ([],[])

\end{haskelllisting}

\function{splitBy} takes a boolean test and a list;
it divides up the list and turns it into a {\em list of sub-lists};
each sub-list consists of
\begin{enumerate}
\item
one element for which the test is true (or the first element in the list), and
\item
all elements after that element for which the test is false.
\end{enumerate}
For example, \code{splitBy (>10) [27, 0, 2, 1, 15, 3, 42, 4]}
yields \code{[ [27,0,2,1], [15,3], [42,4] ]}.
\begin{haskelllisting}

> splitBy :: (a -> Bool) -> [a] -> [[a]]
> splitBy p = dropWhile null . segmentBefore p

> segmentBefore :: (a -> Bool) -> [a] -> [[a]]
> segmentBefore p =
>    foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]

\end{haskelllisting}

\function{segmentBefore} will have at most one empty list at the beginning,
which is dropped by \function{dropWhile}.

It should have signature
  segmentBefore :: (a -> Bool) -> [a] -> ([a], [(a, [a])])
or even better
  segmentBefore :: (a -> Bool) -> [a] -> AlternatingListUniform.T a [a]
and could be implemented using Uniform.fromEitherList

A variant of \function{foldr} and \function{foldr1}
which works only for non-empty lists
and initializes the accumulator depending on the last element of the list.

\begin{haskelllisting}

> foldrf :: (a -> b -> b) -> (a -> b) -> [a] -> b
> foldrf f g =
>    let aux []     = error "foldrf: list must be non-empty"
>        aux (x:[]) = g x
>        aux (x:xs) = f x (aux xs)
>    in  aux

\end{haskelllisting}



Randomly permutate a list.
For this purpose we generate a random \type{Bool} value
for each item of the list
which specifies in what sun-list it is inserted.
Both sublists are then concatenated hereafter.
By repeating this procedure several times
the list should be somehow randomly ordered.

Some notes about perfect shuffling from Oleg:
\url{http://okmij.org/ftp/Haskell/misc.html#perfect-shuffle}

\begin{haskelllisting}

> shuffle :: RandomGen g => [a] -> g -> ([a],g)
> shuffle x g0 =
>    let (choices,g1) = runState (mapM (const (State (randomR (False,True)))) x) g0
>        xc = zip x choices
>    in  (map fst (uncurry (++) (partition snd xc)), g1)

\end{haskelllisting}

Remove consecutive duplicates from a list.
The implementation could avoid \function{head},
if the \function{group} would indicate by its return type,
that all sub-lists are non-empty.
\begin{haskelllisting}

> removeDups :: Eq a => [a] -> [a]
> removeDups = map head . group

\end{haskelllisting}


Given the time fraction that remains from the preceding event
and the current time difference,
evaluate an integer time difference and
the remaining fractional part.
If we would simply map Time to integer values
with respect to the sampling rate,
then rounding errors would accumulate.
\begin{haskelllisting}

> roundDiff' :: (RealFrac t, Integral i) => t -> t -> (i, t)
> roundDiff' time frac =
>    let x = time+frac
>        n = round x
>    in  (n, x - fromIntegral n)

> roundDiff :: (RealFrac t, Integral i) => t -> State t i
> roundDiff = State . roundDiff'

\end{haskelllisting}

Apply two functions on corresponding values.

Instead of pattern matching with say \code{(x,y)}
we use \function{fst} and \function{snd}.
Pattern matching with \code{(x,y)} is too lazy (or too strict?)
so it can be that the pair parameter is the result
of an infinite recursion.
It can not be matched until the recursion is finished,
because the program don't know whether it is bottom.
The functions \function{fst} and \function{snd}
seems to work-around this problem.

\begin{haskelllisting}

> -- Control.Arrow.***
> mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)
> mapPair ~(f,g) ~(x,y) = (f x, g y)
> -- mapPair f x = (fst f (fst x), snd f (snd x))

> -- Control.Arrow.first
> mapFst :: (a -> c) -> (a,b) -> (c,b)
> mapFst f ~(x,y) = (f x, y)

> -- Control.Arrow.second
> mapSnd :: (b -> d) -> (a,b) -> (a,d)
> mapSnd g ~(x,y) = (x, g y)

> flipPair :: (a,b) -> (b,a)
> flipPair (x,y) = (y,x)

\end{haskelllisting}

\function{flattenTuples2} flattens a list of pairs into a list.
Similarly, \function{flattenTuples3} flattens a list of 3-tuples into a list,
and so on.
\begin{haskelllisting}

> flattenTuples2 :: [(a,a)]     -> [a]
> flattenTuples3 :: [(a,a,a)]   -> [a]
> flattenTuples4 :: [(a,a,a,a)] -> [a]
>
> flattenTuples2 = concatMap (\(x,y)     -> [x,y])
> flattenTuples3 = concatMap (\(x,y,z)   -> [x,y,z])
> flattenTuples4 = concatMap (\(x,y,z,w) -> [x,y,z,w])

\end{haskelllisting}



Map all elements by f except the last one, which is kept unchanged.

\begin{haskelllisting}

> mapInit :: (a -> a) -> [a] -> [a]
> mapInit f =
>    foldr (\x ys -> (if null ys then x else f x) : ys) []

  mapInit' :: (a -> a) -> [a] -> [a]
  mapInit' f xs =
     let repf = map (const f) xs  -- replicate f lazily to (length xs)
     in  zipWith ($) (tail (repf ++ [id])) xs

  quickCheck
       (\x -> mapInit succ x == mapInit' succ (x::[Integer]))


  mapInit'' :: (a -> a) -> [a] -> [a]
  mapInit'' f = foldrf (\x ys -> f x : ys) (:[])

  quickCheck
       (\x -> not (null (x::[Integer])) ==>
            mapInit succ x == mapInit' succ x)

\end{haskelllisting}

This is a combination of \function{init} and \function{last}
which avoids memoizing the list
if the last element is accessed after the initial ones.

\begin{haskelllisting}

> splitInit :: [a] -> ([a], a)
> splitInit [] = error "splitInit: empty list"
> splitInit [x] = ([], x)
> splitInit (x:xs) =
>    mapPair ((x:),id) (splitInit xs)

  propSplitInit :: Eq a => [a] -> Bool
  propSplitInit xs =
     splitInit xs  ==  (init xs, last xs)

\end{haskelllisting}

Choose the first element from a list,
and return the default value, if the list is empty.
\begin{haskelllisting}

> headWithDefault :: a -> [a] -> a
> headWithDefault deflt = fromMaybe deflt . listToMaybe

\end{haskelllisting}

Implementation with the partial function \function{head},
which is a bad thing.

\begin{haskelllisting}

  headWithDefault deflt xs = head (xs ++ [deflt])

\end{haskelllisting}



Compare
\begin{haskelllisting}

  let (x,y) = splitInit [0..] in (last x, y)

\end{haskelllisting}
and
\begin{haskelllisting}

  let as = [0..]; (x,y) = (init as, last as) in (last x, y)

\end{haskelllisting}


This function combines every pair of neighbour elements
in a list with a certain function.

\begin{haskelllisting}

> zapWith :: (a -> a -> b) -> [a] -> [b]
> zapWith f x = zipWith f x (tail x)

\end{haskelllisting}

Variants of \function{zip} and \function{zip3}
which check that all argument lists have the same length.

\begin{haskelllisting}

> zipWithMatch :: (a -> b -> c) -> [a] -> [b] -> [c]
> zipWithMatch f (x:xs) (y:ys) = f x y : zipWithMatch f xs ys
> zipWithMatch _ [] [] = []
> zipWithMatch _ _ _ = error "zipWithMatch: lengths of lists differ"

> zipWithMatch3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
> zipWithMatch3 f (x:xs) (y:ys) (z:zs) = f x y z : zipWithMatch3 f xs ys zs
> zipWithMatch3 _ [] [] [] = []
> zipWithMatch3 _ _ _ _ = error "zipWithMatch3: lengths of lists differ"

\end{haskelllisting}

This is a variant of \function{maximum}
which returns at least zero, i.e. always a non-negative number.
This is necessary for determining the length of a parallel music composition
where the empty list has zero duration.

\begin{haskelllisting}

> maximum0 :: (Ord a, Num a) => [a] -> a
> maximum0 = foldl' max 0

\end{haskelllisting}

\begin{haskelllisting}

> maximumKey, minimumKey :: (Ord b) => (a -> b) -> [a] -> a
> maximumKey f = maximumBy (compareField f)
> minimumKey f = minimumBy (compareField f)

\end{haskelllisting}

A combination of \function{min} and \function{max}
for clipping a value to a certain range.

\begin{haskelllisting}

> limit :: (Ord a) => (a,a) -> a -> a
> limit (l,u) = max l . min u

\end{haskelllisting}

From a list of expressions choose the one,
whose condition is true.

\begin{haskelllisting}

> select :: a -> [(Bool, a)] -> a
> select def = maybe def snd . find fst

\end{haskelllisting}


Compare the same field of two records.

\begin{haskelllisting}

> composeDouble :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)
> composeDouble g f x y = g (f x) (f y)

> compareField :: Ord b => (a -> b) -> a -> a -> Ordering
> compareField = composeDouble compare

\end{haskelllisting}

Lexicographically compare a list of attributes of two records.

\begin{haskelllisting}

> compareRecord :: [a -> a -> Ordering] -> a -> a -> Ordering
> compareRecord cs x y =
>    head (dropWhile (EQ==) (map (\c -> c x y) cs) ++ [EQ])

\end{haskelllisting}


\begin{haskelllisting}

> equalField :: Eq b => (a -> b) -> a -> a -> Bool
> equalField = composeDouble (==)

> equalRecord :: [a -> a -> Bool] -> a -> a -> Bool
> equalRecord cs x y = all (\c -> c x y) cs

\end{haskelllisting}


Convert a mapping (i.e. list of pairs) to a function, and use this for a
translation function, which translates every character in a by replacing it by
looking it up in l2 and replacing it with the according character in l2.

\begin{haskelllisting}

> translate :: (Ord a) => [ a ] -> [ a ] -> [ a ] -> [ a ]
> translate l1 l2 a =
>    if length l1 == length l2
>    then let table = Map.fromList (zip l1 l2)
>         in  map (\x -> Map.findWithDefault table x x) a
>    else error "translate: lists must have equal lengths"

\end{haskelllisting}

A random list of integers between 0 and n.

\begin{haskelllisting}

> randList :: Int -> [ Int ]
> randList n = randomRs (0, n) (mkStdGen 0)

\end{haskelllisting}

Is one rational divisible by another one (i.e., is it a integer multiple of it)?

\begin{haskelllisting}

> divisible :: Integral a => Ratio a -> Ratio a -> Bool
> divisible r1 r2 =
>    0 == mod (numerator r1 * denominator r2)
>             (numerator r2 * denominator r1)

\end{haskelllisting}

Do the division.

\begin{haskelllisting}

> divide :: Integral a => Ratio a -> Ratio a -> a
> divide r1 r2 =
>    let (q, r) = divideModulus r1 r2
>    in  if r == 0
>        then q
>        else error "Utility.divide: rationals are indivisible"

> modulus :: Integral a => Ratio a -> Ratio a -> Ratio a
> modulus r1 r2 = snd (divideModulus r1 r2)

> divideModulus :: Integral a => Ratio a -> Ratio a -> (a, Ratio a)
> divideModulus r1 r2 =
>    let (q, r) = divMod (numerator r1 * denominator r2)
>                        (numerator r2 * denominator r1)
>    in  (q, r % (denominator r1 * denominator r2))

\end{haskelllisting}

Also the GCD can be generalized to ratios:

\begin{haskelllisting}

> gcdDur :: Integral a => Ratio a -> Ratio a -> Ratio a
> gcdDur x1 x2 =
>    let a = numerator x1
>        b = denominator x1
>        c = numerator x2
>        d = denominator x2
>    in  gcd a c % lcm b d

\end{haskelllisting}

Returns 'Just' if the precondition is fulfilled.

\begin{haskelllisting}

> toMaybe :: Bool -> a -> Maybe a
> toMaybe False _ = Nothing
> toMaybe True  x = Just x

\end{haskelllisting}

Every element which evaluates to Just is put into the first list.
The second list contains the remaining elements.
It holds \expression{mapMaybe f == fst . partitionMaybe f}
and \expression{partition p == partitionMaybe (\ x -> toMaybe (p x) x)}.

\begin{haskelllisting}

> partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
> partitionMaybe f =
>    foldr (\x ~(y,z) -> case f x of
>              Just x' -> (x' : y, z)
>              Nothing -> (y, x : z)) ([],[])

\end{haskelllisting}