Is there something wrong with my Fisher-Yates shuffle?

Question

Recognizing that when something seems too good to be true, this is usually the case, I figured I would pose this question, hopefully, reset any gremlins. I looked through a few related topics that I could find, but still my question lingers.

I'm relatively new to Haskell, and in my experiments I coded the basic Shuffle Fisher-Yates, as shown below.

shuffle :: RandomGen g => [a] -> g -> ([a],g) shuffle [] g0 = ([],g0) shuffle [x] g0 = ([x],g0) shuffle xs g0 = (x:newtail,g2) where (i,g1) = randomR (0, length $ tail xs) g0 (xs1,x:xs2) = splitAt i xs (newtail,g2) = shuffle (xs1++xs2) g1 

This course implementation uses beaucoup memory for large lists, but it is fast - on my laptop avg 5s for 30M ints versus Std C ++ shuffle on 2.3s). In fact, it is much faster than other Haskell implementations found elsewhere (e.g. http://www.haskell.org/haskellwiki/Random_shuffle )

Given that the other Haskell drags I've seen are more complex and slow, I wonder if acceleration / simplicity is just my reward for being an irreconcilable memory, or if I missed out on some tiny but important details that make my algorithm is biased. I have not tested extensively, but a preliminary look seems to show an even distribution of permutations.

I would appreciate appreciating more eyes with more Haskell experience and / or shuffling. Many thanks in advance to all who are in no hurry to answer.

Answer 1

Let me do the right benchmarking. Here's some code, with your shuffle renamed shuffle1 , and my personal favorite option that was added as shuffle2 .

 import System.Random import Control.Monad import Control.Monad.ST.Strict import Data.STRef.Strict import Data.Vector.Mutable import Prelude as P import Criterion.Main shuffle1 :: RandomGen g => [a] -> g -> ([a], g) shuffle1 [] g0 = ([],g0) shuffle1 [x] g0 = ([x],g0) shuffle1 xs g0 = (x:newtail,g2) where (i,g1) = randomR (0, P.length $ P.tail xs) g0 (xs1,x:xs2) = P.splitAt i xs (newtail,g2) = shuffle1 (xs1++xs2) g1 shuffle2 :: RandomGen g => [a] -> g -> ([a], g) shuffle2 xs g0 = runST $ do let l = P.length xs v <- new l sequence_ $ zipWith (unsafeWrite v) [0..] xs let loop gi | i <= 1 = return g | otherwise = do let i' = i - 1 (j, g') = randomR (0, i') g unsafeSwap vi' j loop g' i' gFinal <- loop g0 l shuffled <- mapM (unsafeRead v) [0 .. l - 1] return (shuffled, gFinal) main = do let s1 x = fst $ shuffle1 x g0 s2 x = fst $ shuffle2 x g0 arr = [0..1000] :: [Int] g0 = mkStdGen 0 -- make sure these values are evaluated before the benchmark starts print (g0, arr) defaultMain [bench "shuffle1" $ nf s1 arr, bench "shuffle2" $ nf s2 arr] 

So, let's see some results:

 carl@ubuntu :~/hask$ ghc -O2 shuffle.hs [1 of 1] Compiling Main ( shuffle.hs, shuffle.o ) Linking shuffle ... carl@ubuntu :~/hask$ ./shuffle (1 1,[0, .. <redacted for brevity>]) warming up estimating clock resolution... mean is 5.762060 us (160001 iterations) found 4887 outliers among 159999 samples (3.1%) 4751 (3.0%) high severe estimating cost of a clock call... mean is 42.13314 ns (43 iterations) benchmarking shuffle1 mean: 10.95922 ms, lb 10.92317 ms, ub 10.99903 ms, ci 0.950 std dev: 193.8795 us, lb 168.6842 us, ub 244.6648 us, ci 0.950 found 1 outliers among 100 samples (1.0%) variance introduced by outliers: 10.396% variance is moderately inflated by outliers benchmarking shuffle2 mean: 256.9394 us, lb 255.5414 us, ub 258.7409 us, ci 0.950 std dev: 8.042766 us, lb 6.460785 us, ub 12.28447 us, ci 0.950 found 1 outliers among 100 samples (1.0%) 1 (1.0%) high severe variance introduced by outliers: 26.750% variance is moderately inflated by outliers 

Well, my system is really noisy and cannot be used to seriously compare things with similar numbers. But that hardly matters. shuffle2 about 40 times faster than shuffle1 in a list with 1001 items. Due to the differences between O (n) and O (n ^ 2), this will increase only with large lists. I am sure that no matter what your test code was, it was not a shuffle algorithm.

Actually, I have an assumption. Your version is lazy enough to return results gradually. 5 seconds is a plausible period of time to get the first few results if you never touch the generator after the call. Perhaps what is happening in your time.