unsort

Here's a small script I wrote partly for wikibook stuff and partly to learn how to use arrays and random numbers in Haskell.

I'm not a particularly enlightened Haskeller, so you might want to be careful about learning from me. Go ask somebody more experienced.

Note: one thing I'm a bit annoyed about is that I can't figure out how to make the unsort function generic, how to make it work for any type of array, element, index. Suggestions and by all means simplifications welcome.

unsort

> import Data.Ix ( Ix )
> import Data.List ( unfoldr )
> import Data.Array.MArray ( MArray, getElems, newListArray, readArray, writeArray )
> import System.Random ( mkStdGen, getStdGen, Random, RandomGen, random, randomR )
> import Data.Array.IO

> main :: IO ()
> main =
>  do gen   <- getStdGen
>     ins   <- lines `fmap` getContents
>     outs  <- unsort gen ins
>     putStr . unlines $ outs

Our objective is to scramble a list. To do this we convert the list into a mutable array and scramble it in place. This consists of traversing the array from left to right, swapping each element N with a random element from N to the end of the array.

> unsort :: RandomGen g => g -> [String] -> IO [String]
> unsort g es =
>  do arr  <- newListArray (l,h) es :: IO (IOArray Int String)
>     unsortH arr l idxs >>= getElems
>  where
>   idxs   = nexts g (l,h)
>   (l, h) = (1, length es)

The swapping itself is pretty straightforward. We swap the element at the
given index at the next random index. Recursion to the next element until
we run out of indices.

> unsortH :: (MArray a e m, Num i, Ix i) => a i e -> i -> [i] -> m (a i e)
> unsortH arr c [] = return arr
> unsortH arr c (r:rs) =
>  do rElem <- readArray arr r
>     cElem <- readArray arr c
>     writeArray arr c rElem
>     writeArray arr r cElem
>     unsortH arr (c+1) rs

And here is how we generate that list of random indices. It is a list [ rM, r(M+1), ..., rN ] where rX is a random number from X to N... Hmm... I'm pretty sure this can be greatly cut down

> nexts :: (RandomGen g, Num n, Ord n, Random n, Ix n) => g -> (n,n) -> [n]
> nexts g (l,h) = unfoldr nxt (g,l,h)
>  where
>    nxt (_,l,h) | l >= h = Nothing
>    nxt (g,l,h) = let (r,g2) = randomR (l,h) g
>                      glh2   = (g2, l + 1, h)
>                  in  Just (r, glh2)