------------------------------------------------------------------------------ -- MiscListUtils.hs -- created: Sun Mar 14 17:00:11 JST 2010 ------------------------------------------------------------------------------ -- A set of functions for operating on lists of floats -- The purpose is to create interesting lists for use in music. module Sound.Conductive.MiscListUtils where import System.Random import Data.List import Data.List.Utils import Data.Array.ST import Control.Monad import Control.Monad.ST import Data.STRef -- based on deltasToTimes and timesToDeltas from SimpleSequencerMarkov.hs deltasToAbsolutes :: (Num a) => a -> [a] -> [a] deltasToAbsolutes start input = scanl (+) start input absolutesToDeltas :: (Num a) => [a] -> [a] absolutesToDeltas [] = [] absolutesToDeltas (x:[]) = [] absolutesToDeltas (x:xs) = ((head xs) - x):absolutesToDeltas xs -- http://old.nabble.com/Request-for-code-review:-slice-1.0.0,-TestSupport-td20658828.html 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 -- randomStutter -- randomStutter (x:xs) n chance = do -- let a = x -- | 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) normalize :: (Fractional a) => a -> [a] -> [a] normalize max x = map (flip (*) (1.0 / max)) x scaleList :: (Fractional a, Ord a) => a -> [a] -> [a] scaleList targetMax xs = let scalar = targetMax/(maximum xs) in map (*scalar) xs 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 ------------------------------------------------------------------------------ -- -- 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 [] ------------------------------------------------------------------------------ -- from here, test data rhythmValues = [0.25,0.5..4] rhythmValues2 = replicator $ zip [64,60..0] rhythmValues phraseLengths = do pl <- pickN 100 [1..8] return $ sort pl phrases :: (Num a, Enum a) => a -> [b] -> IO [[b]] phrases n vs = do pl' <- phraseLengths pl <- pickN n pl' mapM (\x -> pickN x vs) pl