Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Source: http://okmij.org/ftp/Haskell/perfect-shuffle.txt.
- import System.Random
- data Tree a = Leaf a | Node !Int (Tree a) (Tree a) deriving Show
- build_tree = grow_level . (map Leaf)
- where
- grow_level [node] = node
- grow_level l = grow_level $ inner l
- inner [] = []
- inner x@[_] = x
- 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
- shuffle1 :: [a] -> [Int] -> [a]
- shuffle1 elements rseq = shuffle1' (build_tree elements) rseq
- where
- shuffle1' (Leaf e) [] = [e]
- shuffle1' tree (ri:r_others) = extract_tree ri tree
- (\tree -> shuffle1' tree r_others)
- extract_tree 0 (Node _ (Leaf e) r) k = e:k r
- extract_tree 1 (Node 2 l@Leaf{} (Leaf r)) k = r:k l
- extract_tree n (Node c l@Leaf{} r) k =
- extract_tree (n-1) r (\new_r -> k $ Node (c-1) l new_r)
- extract_tree n (Node n1 l (Leaf e)) k | n+1 == n1 = e:k l
- extract_tree n (Node c l@(Node cl _ _) r) k
- | n < cl = extract_tree n l (\new_l -> k $ Node (c-1) new_l r)
- | otherwise = extract_tree (n-cl) r (\new_r -> k $ Node (c-1) l new_r)
- make_rs :: RandomGen g => Int -> g -> ([Int],g)
- make_rs n g = loop [] n g
- where
- loop acc 0 g = (reverse acc,g)
- loop acc n g = let (r,g') = randomR (0,n) g
- in loop (r:acc) (pred n) g'
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement