You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

69 lines
2.4 KiB

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wall #-}
module StrategyManager where
import Control.DeepSeq
import System.Random(StdGen)
import Datatypes.Game(Game,Command)
import Control.DeepSeq (NFData(..))
type Score = Int
type StrategyIdx = Int
type FinishedGame = ([Command], Score, StrategyIdx)
type GameComputation = [StrategyWrapper]
data StrategyWrapper = forall a. (Strategy a) => MkStrategyWrapper a
| FinishedGame ([Command], Int)
instance NFData StrategyWrapper where
rnf (MkStrategyWrapper a) = seq a ()
rnf (FinishedGame b) = seq b ()
initWrapper :: Strategy a => a -> StrategyWrapper
initWrapper a = getbest a `deepseq` (MkStrategyWrapper $! a)
class (NFData a) => Strategy a where
initst :: Game -> StdGen -> [[Command]] -> a
advance :: a -> Either a ([Command], Int)
getbest :: a -> ([Command], Int)
advanceWrapper :: StrategyWrapper -> StrategyWrapper
advanceWrapper (FinishedGame result) = (FinishedGame result)
advanceWrapper (MkStrategyWrapper strategy) = wrapResult $ advance strategy
where
wrapResult (Left nextStrategy) = MkStrategyWrapper nextStrategy
wrapResult (Right result) = FinishedGame result
finishedWrapper :: StrategyWrapper -> Bool
finishedWrapper (FinishedGame _) = True
finishedWrapper _ = False
getbestWrapper :: StrategyWrapper -> ([Command], Int)
getbestWrapper (FinishedGame result) = result
getbestWrapper (MkStrategyWrapper st) = getbest st
--- puo essere parallelizzato ---
finishedGameComputation :: GameComputation -> Bool
finishedGameComputation gc = and $ map finishedWrapper gc
-- Ritorna i comandi con i punti piu l indice della strategia
getBestGameComputation :: GameComputation -> FinishedGame
getBestGameComputation gameComputation = bestGame
where
resultsFromAlgorithms = (map getbestWrapper gameComputation)
algoIdxs = take (length resultsFromAlgorithms) [ i | i <- [0..]]
bestGames = zipWith (\(a,b) c -> (a,b,c)) resultsFromAlgorithms algoIdxs
bestGame = foldl findBest ([], 0, 0) bestGames
findBest best nextBest = if ((bestScore best) > (bestScore nextBest))
then best
else nextBest
bestScore (_, score, _) = score
advanceGameComputation :: GameComputation -> GameComputation
advanceGameComputation gc = map advanceWrapper gc