2007-05-20

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)
at

4 comments:

  1. Anonymous20 May, 2007 19:27

    So, roughly, you're doing a bubble unsort.
    Would be nice to check wether this can also apply to other sorts, such as quicksort or merge sort.

    P!

    ReplyDelete
  2. kowey20 May, 2007 20:27

    I don't know if I would call it at that (I cede to anybody with algo experience); it is just one traversal through the list O(n). Hmm... not sure how other variants of unsorting would look like...

    ReplyDelete
  3. kowey20 May, 2007 20:44

    Heh... and look what turns out on programming.reddit.com: perfect shuffle algorithms

    ReplyDelete
  4. Anonymous20 May, 2007 20:46

    Here's my implementation. I think it's somewhat more idiomatic. I have never used mutable arrays in Haskell. I borrow your clever unfoldr but my code is a lot shorter because I'm just using lists. I'm no Haskell expert either, so I'm sure there is still a yet-shorter, yet-more-idiomatic version.

    -- unsort -- unsorts a list
    -- by Daniel Lyons

    module Main where
    import Data.List
    import System.Random

    -- ! popOut takes an index and returns the value at that index and the list
    -- ! without the value at that index
    popOut :: Int -> [a] -> (a, [a])
    popOut x l = (l !! x, (take x l) ++ (drop (x+1) l))

    -- ! unsort, given a random state and a list, scrambles the list according to
    -- ! the perfect shuffle algorithm
    unsort :: (RandomGen t) => t -> [a] -> [a]
    unsort g l = unfoldr next (g,l)
    where
    next (_, []) = Nothing
    next (g, l) = let (r, g2) = randomR (0, (length l) - 1) g
    (i, rest) = popOut r l
    in Just (i, (g2, rest))

    main = do
    gen <- getStdGen
    interact (unlines . (unsort gen) . lines)

    ReplyDelete