module Utils.ShuffleMWC(shuffle,doShuffle) where
import System.Random.MWC
import Control.Monad(replicateM)
import Control.Applicative((<$>))
import Data.List(genericLength)
data Tree a = Leaf a | Node Int (Tree a) (Tree a) deriving Show
fix f = g where g = f g
build_tree = (fix grow_level) . (map Leaf)
where
grow_level self [node] = node
grow_level self l = self $ inner l
inner [] = []
inner [!e] = [e]
inner (e1:e2:rest) = (join e1 e2) : inner rest
join l@(Leaf _) r@(Leaf _) = Node 2 l r
join l@(Node ct _ _) r@(Leaf _) = Node (ct+1) l r
join l@(Leaf _) r@(Node ct _ _) = Node (ct+1) l r
join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl+ctr) l r
inRange gen (a,b) = do
i :: Float <- uniform gen
return (a+i*(ba))
doShuffle gen elements = do
is <- sequence $ [floor <$> inRange gen (0,fromIntegral $ length elementsi)
| i<-[0..length elements2]]
return $ (shuffle elements is)
shuffle elements rseq = shuffle1' (build_tree elements) rseq
where
shuffle1' (Leaf e) [] = [e]
shuffle1' tree (r:r_others) =
let (b,rest) = extract_tree r tree
in b:(shuffle1' rest r_others)
extract_tree 0 (Node _ (Leaf e) r) = (e,r)
extract_tree 1 (Node 2 (Leaf l) (Leaf r)) = (r,Leaf l)
extract_tree !n (Node c (Leaf l) r) =
let (e,new_r) = extract_tree (n1) r
in (e,Node (c1) (Leaf l) new_r)
extract_tree n (Node n1 l (Leaf e))
| n+1 == n1 = (e,l)
extract_tree n (Node c l@(Node cl _ _) r)
| n < cl = let (e,new_l) = extract_tree n l
in (e,Node (c1) new_l r)
| otherwise = let (e,new_r) = extract_tree (ncl) r
in (e,Node (c1) l new_r)