Misc.hs

-- Various assorted bits and pieces
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}

module Misc where
import GHC.Prim
import GHC.Types
import Data.List
import Control.Parallel.Strategies
import Control.Monad.State

degreesToRadians :: Double -> Double
degreesToRadians x = x * pi / 180

xor :: Bool -> Bool -> Bool
xor True a = not a
xor False a = a

thr :: (x, y, z) -> z
thr (_, _, c) = c

-- Little helper for saturation
saturate :: (Num t, Ord t) => t -> t
saturate x = Prelude.max 0 (Prelude.min x 1)

saturate## :: Double# -> Double#
saturate## !x = value
    where
      !(D# !value) = Prelude.max 0 (Prelude.min (D# x) 1)

harmonicMean :: (Num t, Fractional t) => [t] -> t
harmonicMean array@(_:_) = fromIntegral (length array) / foldl' (\a b -> b + 1 / a) 0 array
harmonicMean [] = 0

-- This performs a map, and passes through the state of the completed operation to the next recursion
-- Couldn't work out the equivalent using the state monad etc
mapS :: (a -> s -> (b, s)) -> [a] -> s -> ([b], s)
mapS f z s = mapS' z s []
    where
      mapS' !(x:xs) !st !acc = seq (result, st') $ mapS' xs st' (result : acc)
          where (!result, !st') = f x st `using` rseq
      mapS' [] !st !acc = (acc, st)

-- Map over a list, passing state from one to the next with the state monad
mapWithState :: [a] -> s -> (a -> State s b) -> ([b], s)
mapWithState arr s f = mapWithState' arr s []
    where
      mapWithState' (x:xs) st acc = mapWithState' xs st' (result : acc)
          where
            (result, st') = runState (f x) st
      mapWithState' [] st acc = (acc, st)

-- Zip over two lists, passing state from one to the next with the state monad
zipWithState :: (a -> b -> State s c) -> [a] -> [b] -> s -> ([c], s)
zipWithState f arr1 arr2 s = zipWithState' arr1 arr2 s []
    where
      zipWithState' (x:xs) (y:ys) st acc = zipWithState' xs ys st' (result : acc)
          where
            (result, st') = runState (f x y) st
      zipWithState' (_:_) [] _ _ = error "Lists are of a different size - unhandled case!"
      zipWithState' [] (_:_) _ _ = error "Lists are of a different size - unhandled case!"
      zipWithState' [] [] st acc = (acc, st)