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

```