------------------------------------------------------------------------------
-- MiscListUtils.hs
-- created: Sun Mar 14 17:00:11 JST 2010
------------------------------------------------------------------------------
-- A set of functions for operating on lists of floats
-- The purpose is creating interesting lists for use in music.
module Sound.Conductive.MiscListUtils where
import System.Random
import Data.List
import Data.Array.ST
import Data.Time.Clock.POSIX
import Control.Monad
import Control.Monad.ST
import Data.STRef
import Sound.Conductive.MusicalTime
unconcat xs = map (\x -> [x]) xs
-- http://old.nabble.com/Request-for-code-review:-slice-1.0.0,-TestSupport-td20658828.html
getSeed = getPOSIXTime >>= \x -> return $ truncate $ x * 100000000
slice :: [a] -> [Int] -> [a]
xs `slice` indices = map (xs !!) indices
replaceAt :: Int -> [a] -> [a] -> [a]
replaceAt i ys xs =
let xz = splitAt i xs
in (fst xz) ++ ys ++ (tail $ snd xz)
-- use this for double-time, creating triplets, fivelets even...
npletAt :: (Fractional a) => Int -> Int -> [a] -> [a]
npletAt n i xs =
let x = xs!!i
plet = replicate n $ x/(fromIntegral n)
in replaceAt i plet xs
-- joins n number of values in list of xs beginning from sp
joinVals :: (Num a) => Int -> Int -> [a] -> [a]
joinVals sp n xs = let
splitXs = splitAt sp xs
newFront = fst splitXs
oldRest = snd splitXs
newRest = [sum $ take n $ oldRest] ++ (snd $ splitAt n oldRest)
in newFront ++ newRest
stutter :: Int -> Int -> Int -> [a] -> [a]
stutter sp l n xs = let
splitList = splitAt sp xs
initial = fst splitList
toBeStuttered = take l $ snd splitList
remainder = snd $ splitAt l $ snd splitList
stuttered = concat $ replicate n toBeStuttered
in initial ++ stuttered ++ remainder
-- modified slightly from http://www.haskell.org/haskellwiki/99_questions/Solutions/24
diff_select :: Int -> Int -> IO [Int]
diff_select n to = diff_select' n [0..to]
diff_select' 0 _ = return []
diff_select' _ [] = error "too few elements to choose from"
diff_select' n xs = do r <- randomRIO (0,(length xs)-1)
let remaining = take r xs ++ drop (r+1) xs
rest <- diff_select' (n-1) remaining
return ((xs!!r) : rest)
randomSubset xs subsetSize = let
len = length xs
in do is <- diff_select subsetSize $ (len - 1)
return $ map (xs!!) is
-- | Randomly shuffle a list without the IO Monad
-- /O(N)/
-- ??? -- where did I get this function from? I didn't write it...
shuffle' :: [a] -> StdGen -> ([a],StdGen)
shuffle' xs gen = runST (do
g <- newSTRef gen
let randomRST lohi = do
(a,s') <- liftM (randomR lohi) (readSTRef g)
writeSTRef g s'
return a
ar <- newArray n xs
xs' <- forM [1..n] $ \i -> do
j <- randomRST (i,n)
vi <- readArray ar i
vj <- readArray ar j
writeArray ar j vi
return vj
gen' <- readSTRef g
return (xs',gen'))
where
n = length xs
newArray :: Int -> [a] -> ST s (STArray s Int a)
newArray n xs = newListArray (1,n) xs
shuffle :: [a] -> IO [a]
shuffle xs = getStdRandom (shuffle' xs)
rotate :: [a] -> Int -> [a]
rotate xs n = drop nn xs ++ take nn xs
where
nn = n `mod` length xs
lace :: [[a]] -> Int -> [a]
lace xss n = let
listNLengths = zip (map length xss) (xss)
selector t x = (snd x)!!(mod t $ fst x)
aRun t = map (selector t) listNLengths
o = ceiling $ (fromIntegral n)/(fromIntegral $ length xss)
in take n $ concat $ map aRun [0..o]
randomList :: Int -> StdGen -> [Int]
randomList n = take n . unfoldr (Just . random)
-- normalizes to 1
normalize xs = map (\x -> x/m) xs where m = maximum xs
normalizeTo t xs = map (\x -> x * m) xs where m = t/(maximum xs)
-- linear interpolation of a point from
-- http://arcanesentiment.blogspot.jp/2009/08/function-of-day-lerp.html
-- retrieved June 2012
lerp (x1,y1) (x2,y2) x = y1 + (x - x1) * (y2 - y1) / (x2 - x1)
rList :: Int -> IO [Int]
rList x = do
seed <- newStdGen
let rs = randomList x seed
return $ map abs rs
-- http://osfameron.vox.com/library/post/random-pain-in-haskell.html
-- pick a = do r <- randomRIO (1, length a)
-- return $ a !! (r - 1)
pick :: [a] -> IO a
pick [] = undefined
pick [x] = do return x
pick (x:xs) = pick' x xs (2 :: Int)
-- pick' :: (Num p, Random p) => t -> [t] -> p -> IO t
pick' curr [] _ = do return curr
pick' curr (next:rest) prob
= do r <- getStdRandom (randomR (1,prob))
let curr' = if r == 1 then next else curr
pick' curr' rest (prob+1)
pickN :: (Num a, Enum a) => a -> [b] -> IO [b]
pickN n xs = mapM (\_ -> pick xs) [1..n]
coin :: IO Bool
coin = pick [True,False]
-- odds against
odds :: Int -> Int -> IO Bool
odds n d = pick $ (replicate n False) ++ (replicate d True)
-- from tuples where fst says how many and snd says what, create the lists
replicator :: [(Int, b)] -> [b]
replicator xs = concat $ map (\x -> replicate (fst x) $ snd x ) xs
-- an alias for replicator
weightedList = replicator
------------------------------------------------------------------------------
-- takeToValue
-- give the maximum sum of a list
-- if the sum is greater than the given value, the list is cropped
-- the final sum is lowered so that the list sum equals the given value
-- if the list is short of the given value, another item is added so that the list sum equals the given value
--
-- This can be used to make a list of values sum to a specific number of beats.
takeToValue' :: (Ord a, Num a) => [a] -> a -> a -> [a] -> [a]
takeToValue' xs val curVal ys
| xs == [] = if (val <= curVal)
then ys
else ys ++ [val-curVal]
| otherwise =
let c = head xs
d = curVal + c
adjustValue input comparison
| input >= comparison = (False,input - comparison)
| input < comparison = (True,0)
test = adjustValue d val
in if (fst test)
then takeToValue' (tail xs) val d $ ys ++ [c]
else takeToValue' ([]) val d $ ys ++ [c - (snd test)]
takeToValue :: (Num a, Ord a) => a -> [a] -> [a]
takeToValue val xs = takeToValue' xs val 0 []
------------------------------------------------------------------------------