rsagl-0.2.1: RSAGL/Auxiliary.hs

module RSAGL.Auxiliary
    (doubles,
     loopedDoubles,
     consecutives,
     loopedConsecutives,
     dropRandomElements,
     matrixMultiplyImpl,
     loopList,
     shiftR,
     zeroToOne,
     constrain,
     debugTime,
     waitParList)
    where

import Data.Array
import System.Random
import System.CPUTime
import Control.Parallel
import Control.Parallel.Strategies
import Debug.Trace

-- doubles transforms a list to a list of adjacent elements.

-- doubles [1,2,3,4,5] = [(1,2),(2,3),(3,4),(4,5)]

doubles :: [a] -> [(a,a)]
doubles [] = []
doubles [_] = []
doubles (x:y:zs) = (x,y) : doubles (y:zs)

-- loopedDoubles transforms a list to a list of adjacent elements, looping back to the beginning of the list.

-- loopedDoubles [1,2,3,4,5] = [(1,2),(2,3),(3,4),(4,5),(5,1)]

loopedDoubles :: [a] -> [(a,a)]
loopedDoubles as = loopedDoubles_ (head as) as
    where loopedDoubles_ _ [] = []
          loopedDoubles_ a [x] = [(x,a)]
          loopedDoubles_ a (x:y:zs) = (x,y) : loopedDoubles_ a (y:zs)

-- consecutives answers a list containing every sequence of n consecutive
-- elements in the parameter.

--consecutives 3 [1,2,3,4] = [[1,2,3],[2,3,4]]

consecutives :: Int -> [a] -> [[a]]
consecutives n xs = let taken = take n xs
			in if (length taken == n)
			   then (taken : (consecutives n $ tail xs))
			   else []

-- loopedConsecutives answers a list containing every sequence of n consecutive
-- elements in the parameter, looping back to the beginning of the list.

-- consecutives 3 [1,2,3,4] = [[1,2,3],[2,3,4],[3,4,1],[4,1,2]]

loopedConsecutives :: Int -> [a] -> [[a]]
loopedConsecutives n xs = consecutives n $ take (n + length xs - 1) $ cycle xs

-- dropRandomElements removes some elements of a list at random.  The first parameter is the number of elements out of 100 that should be included (not dropped).
-- The second is the random number generator, and the third is the list to be operated on.

dropRandomElements :: Int -> StdGen -> [a] -> [a]
dropRandomElements percent _ _ | percent > 100 = error "dropRandomElements: percent > 100"
dropRandomElements percent _ _ | percent < 0 = error "dropRandomElements: percent < 100"
dropRandomElements _ _ [] = []
dropRandomElements percent rand_ints things = 
    let (next_int,next_gen) = next rand_ints
	rest = dropRandomElements percent next_gen (tail things)
	in if (next_int `mod` 100 < percent)
	   then ((head things) : rest)
	   else rest

-- matrixMultiplyImpl implements matrix multiplication.

matrixMultiplyImpl :: (b -> c -> c) -> c -> (a -> a -> b) -> [[a]] -> [[a]] -> [[c]]
matrixMultiplyImpl addOp zero multiplyOp m n = [[foldr addOp zero $ zipWith multiplyOp m' n' | n' <- n] | m' <- m]

-- loopList appends the first element of a list to the end of the list.  The result is a list of one greater length.

-- shiftR shifts every element of a list to the right, recyling the last element as the first.  The result is a list of the same length.

loopList :: [a] -> [a]
loopList ps = ps ++ [head ps]

shiftR :: [a] -> [a]
shiftR ps = last ps : init ps

-- zeroToOne creates a list of numbers from 0.0 to 1.0, using n steps.

zeroToOne :: Integer -> [Double]
zeroToOne n | n > 100000 = trace ("Warning: zeroToOne was asked for " ++ show n ++ " subdivisions, which seems high.  Using 100,000 instead.") zeroToOne 100000
zeroToOne n | n <= 1000 = ztos ! n
zeroToOne n = zeroToOnePrim n

zeroToOnePrim :: Integer -> [Double]
zeroToOnePrim n = map (*x) [0..(fromInteger $ n-1)]
    where x = recip (fromInteger $ n - 1)

ztos :: Array Integer [Double]
ztos = listArray (0,1000) $ map (zeroToOnePrim) [0 .. 1000]

-- constrain restricts the effective domain of a function.  Outside of the restricted domain, the function is id

constrain :: (a -> Bool) -> (a -> a) -> a -> a
constrain f g x = if f x then g x else x

-- debugTime prints a statement indicating how long an IO action takes to complete

debugTime :: String -> IO a -> IO a
debugTime msg io_action =
    do print $ "debugTime: starting " ++ msg
       start_time <- getCPUTime
       result <- io_action
       end_time <- getCPUTime
       print $ "debugTime: done with " ++ msg ++ " " ++ show (end_time - start_time)
       return result

-- as parList, but waits until the list is fully evaluated.

waitParList :: Strategy a -> Strategy [a]
waitParList s a = parList s a `pseq` seqList s a