diff --git a/doc/paper.pdf b/doc/paper.pdf new file mode 100644 index 0000000..00d0d41 Binary files /dev/null and b/doc/paper.pdf differ diff --git a/src/MonadicGame.hs b/src/MonadicGame.hs index 6df4266..e7bf61f 100644 --- a/src/MonadicGame.hs +++ b/src/MonadicGame.hs @@ -1,13 +1,13 @@ {-# OPTIONS -Wall #-} -module MonadicGame(executeGame, move, moves, readScore, readNote) where +module MonadicGame(executeGame, move, moves, readScore, readNote, getBestMovesFromHere, saveGame, loadGame, deleteSavedGame, deleteAllSaved, loadFromGame, executeStepCommands, retrieveGameData) where import Control.Applicative +import qualified Data.HashMap as M +import Data.Maybe import Datatypes.Game import VM - - -data MonadicGameInternal = MonadicGameInternal { igame :: Game , inote :: Notes} +data MonadicGameInternal = MonadicGameInternal { igame :: Game , inote :: Notes, isaves :: M.Map String (Game,Notes) } data MonadicGame a = MonadicAction {action :: (MonadicGameInternal -> (MonadicGameInternal, a))} @@ -50,22 +50,40 @@ readGame readFunction = modifyGame (\_ x -> (x, readFunction x)) () writeGame :: (a -> MonadicGameInternal -> MonadicGameInternal) -> a -> MonadicGame () writeGame writeFunction = modifyGame (\x y -> (writeFunction x y, ())) ------- Public Functions ----- +----------------------------- + +------ Public Functions ----- --- Apply the monad to a Game +-- Apply the monad to a Game, return the list of command to execute and the score executeGame :: Game -> MonadicGame () -> ([Command], Int) -executeGame game (MonadicAction finalFunction) = (history executedGame, score executedGame) +executeGame game (MonadicAction actions) = (history executedGame, score executedGame) where - executedGame = (igame . fst . finalFunction) (MonadicGameInternal{igame = game, inote = OK}) + executedGame = (igame . fst . actions) (MonadicGameInternal{igame = game, inote = OK, isaves = M.empty}) +loadFromGame :: Game -> MonadicGameInternal +loadFromGame game = (MonadicGameInternal{igame = game, inote = OK, isaves = M.empty}) + +executeStepCommands :: MonadicGame () -> MonadicGameInternal -> MonadicGameInternal +executeStepCommands (MonadicAction actions) game = newGame + where + newGame = (fst . actions) game + +retrieveGameData :: MonadicGameInternal -> ([Command],Int) +retrieveGameData game = bestData + where + bestData = M.fold findBestFun initData (isaves game) + initData = ((history . igame) game, (score . igame) game) + findBestFun procEl (bestHist,bestScore) = if bestScore > (score . fst) procEl + then (bestHist,bestScore) + else (bestHist,bestScore) -- Execute a command move :: Command -> MonadicGame () move command = writeGame applyMove command where applyMove param oldGameInternal = newInternals where - newInternals = MonadicGameInternal {igame = newIgame, inote = newInote} + newInternals = oldGameInternal{igame = newIgame, inote = newInote} newIgame = fst $ step (igame oldGameInternal) param newInote = snd $ step (igame oldGameInternal) param @@ -81,4 +99,57 @@ readScore = readGame (score . igame) readNote :: MonadicGame Notes readNote = readGame inote +getBestMovesFromHere :: [MonadicGame ()] -> MonadicGame () +getBestMovesFromHere [] = return () +getBestMovesFromHere movesArr = writeGame bestGameFun movesArr + where + bestGameFun param oldGameInternal = bestBranch + where + bestBranch = foldl maxBranch oldGameInternal gameBranches + gameBranches = map (\x -> (fst . (action x)) oldGameInternal) param + maxBranch oldMax actualBranch = if (score . igame $ oldMax) > (score . igame $ actualBranch) + then oldMax + else actualBranch + +saveGame :: String -> MonadicGame () +saveGame saveStr = writeGame saveGameFun saveStr + where + saveGameFun param oldGameInternal = savedGameInternal + where + savedGameInternal = oldGameInternal{isaves = (M.insert param (actualIgame,actualNote) actualIsaves)} + actualIsaves = isaves oldGameInternal + actualIgame = igame oldGameInternal + actualNote = inote oldGameInternal + +loadGame :: String -> MonadicGame Bool +loadGame loadStr = modifyGame loadGameFun loadStr + where + loadGameFun param oldGameInternal = (loadedGameInternal, loaded) + where + lookupResult = M.lookup param (isaves oldGameInternal) + (loadedGame, loadedNote, loaded) = if isJust lookupResult + then (fst $ fromJust lookupResult,snd $ fromJust lookupResult, True) + else (igame oldGameInternal, inote oldGameInternal, False) + loadedGameInternal = oldGameInternal{igame = loadedGame, inote = loadedNote} + + +deleteSavedGame :: String -> MonadicGame Bool +deleteSavedGame delStr = modifyGame deleteSavedGameFun delStr + where + deleteSavedGameFun param oldGameInternal = (deletedSavedGameInternal, deleted) + where + oldGameISaved = isaves oldGameInternal + deleted = M.member param oldGameISaved + deletedSavedGameInternal = if deleted + then oldGameInternal{isaves = (M.delete param oldGameISaved)} + else oldGameInternal + + +deleteAllSaved :: MonadicGame () +deleteAllSaved = writeGame deleteAllSavedGameFun () + where + deleteAllSavedGameFun _ oldGameInternal = deletedAllSavedGameInternal + where + deletedAllSavedGameInternal = oldGameInternal{isaves = M.empty} + -----------------------------