[Haskell-cafe] Linear shuffle
Keean Schupke
k.schupke at imperial.ac.uk
Fri Jan 14 04:12:28 EST 2005
Gracjan Polak wrote:
>
> This algorithm seems not effective, length, take, drop and (!!) are
> costly. Is there any better way to implement shuffle?
>
Here is an algorithm known as a perfect-shuffle... I am not too sure of
the efficiency compared to the example you gave, but it builds a tree to
enable faster lookup.
Keean
module Lib.MetaSearch.Shuffle(shuffle) where
import Random
import Int
import GHC.IOBase (unsafeInterleaveIO)
data Tree a = Leaf a | Node !Int (Tree a) (Tree a) deriving Show
buildTree :: [a] -> Tree a
buildTree = growLevel . (map Leaf) where
growLevel :: [Tree a] -> Tree a
growLevel [node] = node
growLevel l = growLevel (inner l)
inner :: [Tree a] -> [Tree a]
inner [] = []
inner [e] = [e]
inner (e1:e2:rest) = join e1 e2 : inner rest
join :: Tree a -> Tree a -> Tree a
join l@(Leaf _) r@(Leaf _) = Node 2 l r
join l@(Node i _ _) r@(Leaf _) = Node (i+1) l r
join l@(Leaf _) r@(Node i _ _) = Node (i+1) l r
join l@(Node i _ _) r@(Node j _ _) = Node (i+j) l r
shuffle1 :: [a] -> [Int] -> [a]
shuffle1 elements rseq = shuffle' (buildTree elements) rseq where
shuffle' :: Tree a -> [Int] -> [a]
shuffle' (Leaf e) [] = [e]
shuffle' tree (r0:rs) =
case extractTree r0 tree of
(b0,bs) -> b0 : shuffle' bs rs
extractTree :: Int -> Tree a -> (a,Tree a)
extractTree 0 (Node _ (Leaf e) r) = (e,r)
extractTree 1 (Node 2 (Leaf l) (Leaf r)) = (r,Leaf l)
extractTree n (Node c (Leaf l) r) = case extractTree (n-1) r of
(e,r') -> (e,Node (c-1) (Leaf l) r')
extractTree n (Node c l (Leaf e))
| n+1 == c = (e,l)
extractTree n (Node c l@(Node c1 _ _) r)
| n < c1 = case extractTree n l of
(e,l') -> (e,Node (c-1) l' r)
| otherwise = case extractTree (n-c1) r of
(e,r') -> (e,Node (c-1) l r')
randList :: Int -> IO [Int]
randList 1 = return []
randList n = do
a0 <- getStdRandom $ randomR (0,n-1)
as <- unsafeInterleaveIO $ randList (n-1)
return (a0:as)
shuffle :: [a] -> IO [a]
shuffle s = do
a <- randList $ length s
return $ shuffle1 s a
More information about the Haskell-Cafe
mailing list