qsort.hs

import Control.Monad
import Data.Array.IO
import System.Random

-- TODO: I should be able to do this with the ST monad, but I'm not
-- smart enough for that yet.

-- ArraySlice data type. I probably should be able to parameterize
-- over the kind of MArray. Indeed, ArraySlice probably can implement
-- MArray itself!
--
-- http://hackage.haskell.org/package/array-0.5.2.0/docs/Data-Array-MArray.html
data ArraySlice = ArraySlice (IOArray Int Int) Int Int

readArraySlice :: ArraySlice -> Int -> IO Int
readArraySlice as@(ArraySlice arr offset _) idx = do
  readArray arr (offset + idx)

writeArraySlice :: ArraySlice -> Int -> Int -> IO ()
writeArraySlice as@(ArraySlice arr offset _) idx val = do
  writeArray arr (offset + idx) val

resliceArraySlice as@(ArraySlice arr offset _) newOffset newLen =
  ArraySlice arr (offset + newOffset) newLen

asLength as@(ArraySlice _ _ len) = len

-- Moves all items smaller than the pivot to the left of the
-- pivot. Everything greater is moved to the right of the pivot.
partition :: ArraySlice -> Int -> Int -> IO Int
partition as pivotIdx idx
  | idx == (asLength as) =
      return pivotIdx
  | otherwise = do
      pivot <- readArraySlice as pivotIdx
      el <- readArraySlice as idx
      if el < pivot
        then do
          let nextIdx = pivotIdx + 1
          nextEl <- readArraySlice as nextIdx
          writeArraySlice as idx nextEl
          writeArraySlice as nextIdx pivot
          writeArraySlice as pivotIdx el
          partition as (pivotIdx + 1) (idx + 1)
        else do
          partition as pivotIdx (idx + 1)

-- QuickSort runs the partition subroutine to place the pivot, and
-- then sorts the left and right halves recursively.
--
-- The whole point of this gist is to show how to do this *in
-- place*. The whole point of quick sort is to do it in place. But
-- most introductions to Haskell will show you how to do it in an
-- immutable (and extremely inefficient) way.
qsort :: ArraySlice -> IO ()
qsort as
  | (asLength as) == 0 = do
      return ()
  | otherwise = do
      pivotIdx <- partition as 0 0
      let leftLen = pivotIdx
      qsort (resliceArraySlice as 0 leftLen)
      let rightLen = (asLength as) - (pivotIdx + 1)
      qsort (resliceArraySlice as (pivotIdx + 1) rightLen)

numElems = 100
maxValue = 1000

main :: IO ()
main = do
  -- Generate random list of numbers
  -- http://hackage.haskell.org/package/random-1.1/docs/System-Random.html
  gen <- newStdGen
  let elems = take numElems (randomRs (0, maxValue) gen)

  -- Build the array for in place sorting.
  -- http://hackage.haskell.org/package/array-0.5.2.0/docs/Data-Array-IO.html
  arr <- (newListArray (0, numElems - 1) elems) :: IO (IOArray Int Int)

  -- Sort them!
  qsort (ArraySlice arr 0 numElems)

  -- Extract list and print!
  elems <- getElems arr
  forM_ elems $ \el -> do
    putStrLn (show el)

See version 2 here: https://gist.github.com/ruggeri/f33956061fb8449e26f11145b1ad9d40