Utility.hs

module Data.EventList.Utility where

-- State monad could be avoided by mapAccumL
import Control.Monad.Trans.State (State, state, modify, gets, )
import qualified Data.List as List

{- |
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.
-}

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'

{-
We could use 'properFraction' but this is inconsistent for negative values.
-}
floorDiff :: (RealFrac t, Integral i) => t -> State t i
floorDiff t =
   do modify (t+)
      n <- gets floor
      modify (subtract (fromIntegral n))
      return n

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

-- 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)


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


{-|
Given two lists that are ordered
(i.e. @p x y@ holds for subsequent @x@ and @y@)
'mergeBy' them into a list that is ordered, again.

This used for merging event lists with absolute time stamps.
-}

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


beforeBy :: (Ord time) =>
   (body -> body -> Bool) ->
   (time, body) -> (time, body) ->  Bool
beforeBy before (t0, me0) (t1, me1) =
   case compare t0 t1 of
      LT -> True
      EQ -> before me0 me1
      GT -> False


{- |
This is a combination of 'init' and 'last'
which avoids memoizing the list
if the last element is accessed after the initial ones.

> let a = [0..10000000::Int] in (last (init a), last a)
> let a = [0..10000000::Int]; (bs,b)=splitInit a in (last bs, b)
-}
splitInit :: [a] -> ([a], a)
splitInit (x:xs) =
   if null xs
     then ([], x)
     else mapFst (x:) (splitInit xs)
splitInit [] = error "splitInit: empty list"

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


viewR :: [a] -> Maybe ([a], a)
viewR =
   foldr (\x mxs -> Just (maybe ([],x) (mapFst (x:)) mxs)) Nothing

propViewR :: Eq a => [a] -> Bool
propViewR xs =
   maybe True
      ((init xs, last xs) == )
      (viewR xs)


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

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


isMonotonic :: (Ord a) => [a] -> Bool
isMonotonic = and . isMonotonicLazy

isMonotonicLazy :: (Ord a) => [a] -> [Bool]
isMonotonicLazy xs = zipWith (<=) xs (tail xs)



slice :: (Eq a) =>
   (eventlist -> Maybe body) ->
   ((body -> Bool) -> eventlist -> (eventlist, eventlist)) ->
   (body -> a) -> eventlist -> [(a, eventlist)]
slice hd partition f =
   List.unfoldr (\ pf ->
      fmap
         ((\ i ->
            mapPair
               ((,) i, id)
               (partition ((i==) . f) pf)) . f)
         (hd pf))