Advertisement
Guest User

Untitled

a guest
Oct 23rd, 2016
64
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.08 KB | None | 0 0
  1. data Bin a = Leaf a | Bin (Bin a) Int (Bin a) deriving Show
  2.  
  3. count (Bin _ n _ ) = n
  4. count (Leaf _) = 1
  5.  
  6. fromListB :: [a] -> Bin a
  7. fromListB = head . head . dropWhile ((>1) . length) .
  8. iterate (collapse id ((+) `on` count) ) . collapse Leaf (\_ _ -> 2)
  9.  
  10. collapse f g (x:y:rest) = Bin (f x) (x `g` y) (f y) : collapse f g rest
  11. collapse f g [x] = [f x]
  12. collapse f g [] = []
  13.  
  14. select :: Int -> Bin a -> (a, Maybe (Bin a))
  15. select 0 (Bin (Leaf x) n r) = (x,Just r)
  16. select 0 (Leaf x) = (x, Nothing)
  17. select 1 (Bin l _ (Leaf x)) = (x,Just l)
  18. select n (Bin l ((==) (n + 1) -> True) r@(Leaf x)) = (x, Just l)
  19. select n (Bin l c r) = (\(f,(x,t)) -> (x,f <$> t)) $ case n < cl of
  20. True -> (\l -> Bin l (c - 1) r, select n l)
  21. False -> (Bin l (c - 1), select (n - cl) r)
  22. where cl = count l
  23.  
  24.  
  25. shuffle ns = f ns . fromListB where
  26. f (n:ns) t = case select (n `mod` count t) t of
  27. (x,Nothing) -> [x]
  28. (x,Just t') -> x : f ns t'
  29.  
  30. shuffleIO xs = flip shuffle xs <$> randoms <$> newStdGen
  31.  
  32. toTree (Leaf a) = Node (show a) []
  33. toTree (Bin l n r) = Node (show n) [toTree l, toTree r]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement