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