------------------------------------------------------------------------------

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