Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- data Bin a = Leaf a | Bin (Bin a) Int (Bin a) deriving Show
- count (Bin _ n _ ) = n
- count (Leaf _) = 1
- fromListB :: [a] -> Bin a
- fromListB = head . head . dropWhile ((>1) . length) .
- iterate (collapse id ((+) `on` count) ) . collapse Leaf (\_ _ -> 2)
- collapse f g (x:y:rest) = Bin (f x) (x `g` y) (f y) : collapse f g rest
- collapse f g [x] = [f x]
- collapse f g [] = []
- select :: Int -> Bin a -> (a, Maybe (Bin a))
- select 0 (Bin (Leaf x) n r) = (x,Just r)
- select 0 (Leaf x) = (x, Nothing)
- select 1 (Bin l _ (Leaf x)) = (x,Just l)
- select n (Bin l ((==) (n + 1) -> True) r@(Leaf x)) = (x, Just l)
- select n (Bin l c r) = (\(f,(x,t)) -> (x,f <$> t)) $ case n < cl of
- True -> (\l -> Bin l (c - 1) r, select n l)
- False -> (Bin l (c - 1), select (n - cl) r)
- where cl = count l
- shuffle ns = f ns . fromListB where
- f (n:ns) t = case select (n `mod` count t) t of
- (x,Nothing) -> [x]
- (x,Just t') -> x : f ns t'
- shuffleIO xs = flip shuffle xs <$> randoms <$> newStdGen
- toTree (Leaf a) = Node (show a) []
- toTree (Bin l n r) = Node (show n) [toTree l, toTree r]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement