Shuffle.hs

{-  
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2014 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Mp.Utils.Shuffle (
    ShuffleData,
    ShuffleValue,
    ShuffleState,
    shuffleInitial,
    shuffleEmpty,
    shuffleFilled,
    shuffleAdd,
    shuffleRemove,
    shuffleFunction
) where

import Control.Monad.State
import System.Random
import Data.List

type ShuffleData  = (StdGen, Bool, Int, [(Int, Int)], [(Int, Int)])
type ShuffleValue = Int -> Int
type ShuffleState = State ShuffleData ShuffleValue

sortFunction :: (Int, Int) -> (Int, Int) -> Ordering
sortFunction (a, _) (b, _)
    | a < b     = LT
    | a > b     = GT
    | otherwise = EQ

shuffleInitial :: StdGen -> ShuffleData
shuffleInitial g = (g, True, 0, [], [])

shuffleEmpty :: ShuffleState
shuffleEmpty = return id

shuffleFilled :: Int -> ShuffleState
shuffleFilled ln = do
    forM_ [1..ln] $ \_ ->
        shuffleAdd
    shuffleFunction

shuffleAdd :: ShuffleState
shuffleAdd = do
    (g0, _, index, list, sorted) <- get
    let (r, g1) = random g0
    put (g1, True, succ index, (r, index) : list, sorted)
    return id

shuffleRemove :: ShuffleState
shuffleRemove = do
    (g0, _, index, list, sorted) <- get
    if (index == 0) then
        return id
    else do
        put (g0, True, pred index, tail list, sorted)
        return id

shuffleFunction :: ShuffleState
shuffleFunction = do
    (g0, changed, index, list, sorted) <- get
    if changed
        then do
            let newList = sortBy sortFunction list
            put (g0, False, index, list, newList)
            return $ \i ->
                if i < 0 then i
                else snd (newList !! i)
        else
            return $ \i ->
                if i < 0 then i
                else snd (sorted !! i)