Utility.hs

module Game.Utility where

import qualified System.Random as Rnd

import qualified Control.Monad.Trans.State as MS
import Control.Monad (liftM, liftM2)

import qualified Data.Foldable as Fold
import qualified Data.EnumMap as EnumMap
import qualified Data.Map as Map
import Data.EnumMap (EnumMap)
import Data.Map (Map)

import qualified Test.QuickCheck as QC


readMaybe :: (Read a) => String -> Maybe a
readMaybe str =
   case reads str of
      [(a,"")] -> Just a
      _ -> Nothing

nullToMaybe :: [a] -> Maybe [a]
nullToMaybe [] = Nothing
nullToMaybe s  = Just s

-- candidate for random-utility, cf. module htam:Election, markov-chain
-- for Sets it would be more efficient to use Set.elemAt
randomSelect :: (Rnd.RandomGen g, Monad m) => [a] -> MS.StateT g m a
randomSelect items =
   liftM (items!!) $ MS.state $ Rnd.randomR (0, length items-1)


histogram :: (Ord a) => [a] -> Map a Int
histogram = Map.fromListWith (+) . map (\a -> (a,1))


-- unfortunately it is not a Monoid because mergeChoice is not associative
data Choice a = Choice (EnumMap a Int) Int
   deriving (Eq, Show)

instance (QC.Arbitrary a, Enum a) => QC.Arbitrary (Choice a) where
   arbitrary = do
      bag <-
         fmap EnumMap.fromList $ QC.listOf $
         liftM2 (,) QC.arbitrary (fmap QC.getNonNegative QC.arbitrary)
      count <- QC.choose (0, Fold.sum bag)
      return $ Choice bag count
   shrink (Choice bag count) =
      map (\(xs,c) ->
            let b = fmap abs $ EnumMap.fromList xs
            in Choice b (min c $ Fold.sum b)) $
      QC.shrink (EnumMap.toList bag, count)

noChoice :: (Enum a) => Choice a
noChoice = Choice EnumMap.empty 0

-- it is hard to test whether fullEval absorbs
mergeChoice :: (Enum a) => Choice a -> Choice a -> Choice a
mergeChoice (Choice symbolsA countA) (Choice symbolsB countB) =
   Choice
      (EnumMap.unionWith max symbolsA symbolsB)
      (countA + countB
         - min (min countA countB)
               (Fold.sum (EnumMap.intersectionWith min symbolsA symbolsB)))