------------------------------------------------------------------------------ -- 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 [] ------------------------------------------------------------------------------