|
|
@ -1,4 +1,4 @@ |
|
|
|
module Datatypes.Game (Game(..), Command(..), completed, new, cacheToScore, updateCache, powerPhrases, phraseConverter) where -- FIXME exports |
|
|
|
module Datatypes.Game (Game(..), Command(..), isCompleted, new, notifyCommand, powerCounterToScore, powerPhrasesAsCommands, commandsToString) where -- FIXME exports |
|
|
|
|
|
|
|
import Data.Hashable (hash) |
|
|
|
import qualified Data.List as List |
|
|
@ -12,16 +12,16 @@ import Datatypes.Unit (Unit) |
|
|
|
import qualified Datatypes.Unit as Unit |
|
|
|
|
|
|
|
data Command = MoveW |
|
|
|
| MoveSE |
|
|
|
| MoveE |
|
|
|
| MoveSW |
|
|
|
| MoveSE |
|
|
|
| RotateClockwise |
|
|
|
| RotateCounterclockwise |
|
|
|
deriving (Show,Eq,Ord) |
|
|
|
|
|
|
|
type UnitHash = Int |
|
|
|
|
|
|
|
type PhrasesCache = Map [Command] Int |
|
|
|
type PowerCounter = Map String Int |
|
|
|
|
|
|
|
data Game = Game { |
|
|
|
board :: Board, |
|
|
@ -30,12 +30,12 @@ data Game = Game { |
|
|
|
oldLines :: Int, |
|
|
|
score :: Int, |
|
|
|
history :: [Command], |
|
|
|
phrasesCache :: PhrasesCache |
|
|
|
powerCounter :: PowerCounter |
|
|
|
} |
|
|
|
deriving Show |
|
|
|
|
|
|
|
completed :: Game -> Bool |
|
|
|
completed game = null $ units game |
|
|
|
isCompleted :: Game -> Bool |
|
|
|
isCompleted game = null $ units game |
|
|
|
|
|
|
|
new :: Board -> [Unit] -> Game |
|
|
|
new b us = Game { |
|
|
@ -45,31 +45,100 @@ new b us = Game { |
|
|
|
oldLines = 0, |
|
|
|
score = 0, |
|
|
|
history = [], |
|
|
|
phrasesCache = Map.empty |
|
|
|
powerCounter = Map.empty |
|
|
|
} where (c:cs) = map (flip Unit.centeredIn b) us |
|
|
|
|
|
|
|
phraseConverter :: [Command] -> String |
|
|
|
phraseConverter s = if s == reverse [MoveE, MoveSW, MoveW] |
|
|
|
then "ei!" |
|
|
|
else if s == reverse [MoveSW, MoveSW, MoveW, MoveSE, MoveSW, MoveSW, MoveW] |
|
|
|
then "ia! ia!" |
|
|
|
else "PUPPA" |
|
|
|
|
|
|
|
powerPhrases :: [[Command]] |
|
|
|
powerPhrases = [ |
|
|
|
reverse [MoveE, MoveSW, MoveW], |
|
|
|
reverse [MoveSW, MoveSW, MoveW, MoveSE, MoveSW, MoveSW, MoveW] |
|
|
|
] |
|
|
|
|
|
|
|
updateCache :: PhrasesCache -> [Command] -> PhrasesCache |
|
|
|
updateCache cache history = innerUpdate cache history powerPhrases where |
|
|
|
innerUpdate cache _ [] = cache |
|
|
|
innerUpdate cache history (p:ps) = innerUpdate (updatedCache cache history p) history ps |
|
|
|
updatedCache c h p | p `List.isPrefixOf` h = if Map.member p c |
|
|
|
then Map.update (\a -> Just $ a + 1) p c |
|
|
|
else Map.insert p 1 c |
|
|
|
updatedCache c _ _ = c |
|
|
|
|
|
|
|
cacheToScore :: PhrasesCache -> Int |
|
|
|
cacheToScore items = sum $ map evalScore (Map.toAscList items) where |
|
|
|
evalScore (phrase, count) = 2 * (length phrase) * count + if count > 0 then 300 else 0 |
|
|
|
powerPhrases :: Map String [Command] |
|
|
|
powerPhrases = Map.fromList $ map (\x -> (x, stringToCommands x)) keys where |
|
|
|
keys = ["ei!", "ia! ia!", "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.", " r'lyeh", "yogsothoth", "necronomicon", "yuggoth", "john bigboote"] |
|
|
|
|
|
|
|
powerPhrasesAsCommands :: [[Command]] |
|
|
|
powerPhrasesAsCommands = map snd $ Map.toList powerPhrases |
|
|
|
|
|
|
|
reversedPowerPhrases :: [([Command], String)] |
|
|
|
reversedPowerPhrases = swapTuples . Map.toList $ powerPhrases where |
|
|
|
swapTuples = map (\(s, cs) -> (reverse cs, s)) |
|
|
|
|
|
|
|
notifyCommand :: Game -> Command -> Game |
|
|
|
notifyCommand game command = |
|
|
|
game { history = newHistory, powerCounter = newPowerCounter } where |
|
|
|
newHistory = command:(history game) |
|
|
|
newPowerCounter = updatePowerCounter (powerCounter game) newHistory |
|
|
|
|
|
|
|
updatePowerCounter :: PowerCounter -> [Command] -> PowerCounter |
|
|
|
updatePowerCounter counter history = |
|
|
|
innerUpdate counter reversedPowerPhrases where |
|
|
|
innerUpdate :: PowerCounter -> [([Command], String)] -> PowerCounter |
|
|
|
innerUpdate c [] = c |
|
|
|
innerUpdate c (p:ps) = innerUpdate (checkPrefix c p) ps |
|
|
|
checkPrefix m (p, s) = if p `List.isPrefixOf` history |
|
|
|
then incrementMember m s |
|
|
|
else m |
|
|
|
incrementMember m s = Map.insertWith (\_ old -> old + 1) s 1 m |
|
|
|
|
|
|
|
powerCounterToScore :: PowerCounter -> Int |
|
|
|
powerCounterToScore items = sum $ map evalScore (Map.toAscList items) where |
|
|
|
evalScore (phrase, count) = 2 * (length phrase) * count + (if count > 0 then 300 else 0) |
|
|
|
|
|
|
|
stringToCommands :: String -> [Command] |
|
|
|
stringToCommands str = reverse (convert str []) where |
|
|
|
convert [] acc = acc |
|
|
|
convert ('p':cs) acc = convert cs (MoveW:acc) |
|
|
|
convert ('\'':cs) acc = convert cs (MoveW:acc) |
|
|
|
convert ('!':cs) acc = convert cs (MoveW:acc) |
|
|
|
convert ('.':cs) acc = convert cs (MoveW:acc) |
|
|
|
convert ('0':cs) acc = convert cs (MoveW:acc) |
|
|
|
convert ('3':cs) acc = convert cs (MoveW:acc) |
|
|
|
convert ('b':cs) acc = convert cs (MoveE:acc) |
|
|
|
convert ('c':cs) acc = convert cs (MoveE:acc) |
|
|
|
convert ('e':cs) acc = convert cs (MoveE:acc) |
|
|
|
convert ('f':cs) acc = convert cs (MoveE:acc) |
|
|
|
convert ('y':cs) acc = convert cs (MoveE:acc) |
|
|
|
convert ('2':cs) acc = convert cs (MoveE:acc) |
|
|
|
convert ('a':cs) acc = convert cs (MoveSW:acc) |
|
|
|
convert ('g':cs) acc = convert cs (MoveSW:acc) |
|
|
|
convert ('h':cs) acc = convert cs (MoveSW:acc) |
|
|
|
convert ('i':cs) acc = convert cs (MoveSW:acc) |
|
|
|
convert ('j':cs) acc = convert cs (MoveSW:acc) |
|
|
|
convert ('4':cs) acc = convert cs (MoveSW:acc) |
|
|
|
convert ('l':cs) acc = convert cs (MoveSE:acc) |
|
|
|
convert ('m':cs) acc = convert cs (MoveSE:acc) |
|
|
|
convert ('n':cs) acc = convert cs (MoveSE:acc) |
|
|
|
convert ('o':cs) acc = convert cs (MoveSE:acc) |
|
|
|
convert (' ':cs) acc = convert cs (MoveSE:acc) |
|
|
|
convert ('5':cs) acc = convert cs (MoveSE:acc) |
|
|
|
convert ('d':cs) acc = convert cs (RotateClockwise:acc) |
|
|
|
convert ('q':cs) acc = convert cs (RotateClockwise:acc) |
|
|
|
convert ('r':cs) acc = convert cs (RotateClockwise:acc) |
|
|
|
convert ('v':cs) acc = convert cs (RotateClockwise:acc) |
|
|
|
convert ('z':cs) acc = convert cs (RotateClockwise:acc) |
|
|
|
convert ('1':cs) acc = convert cs (RotateClockwise:acc) |
|
|
|
convert ('k':cs) acc = convert cs (RotateCounterclockwise:acc) |
|
|
|
convert ('s':cs) acc = convert cs (RotateCounterclockwise:acc) |
|
|
|
convert ('t':cs) acc = convert cs (RotateCounterclockwise:acc) |
|
|
|
convert ('u':cs) acc = convert cs (RotateCounterclockwise:acc) |
|
|
|
convert ('w':cs) acc = convert cs (RotateCounterclockwise:acc) |
|
|
|
convert ('x':cs) acc = convert cs (RotateCounterclockwise:acc) |
|
|
|
convert ('\t':cs) acc = convert cs acc |
|
|
|
convert ('\n':cs) acc = convert cs acc |
|
|
|
convert ('\r':cs) acc = convert cs acc |
|
|
|
|
|
|
|
commandsToString :: [Command] -> String |
|
|
|
commandsToString [] = "" |
|
|
|
commandsToString cmds@(c:cs) = |
|
|
|
case smartConvert cmds (map (\(a, b) -> (b, a)) $ Map.toList powerPhrases) of |
|
|
|
Just word -> word ++ (commandsToString (drop (length word) cmds)) |
|
|
|
Nothing -> dumbConvert c : commandsToString cs |
|
|
|
where |
|
|
|
dumbConvert MoveW = 'p' |
|
|
|
dumbConvert MoveE = 'b' |
|
|
|
dumbConvert MoveSW = 'a' |
|
|
|
dumbConvert MoveSE = 'l' |
|
|
|
dumbConvert RotateClockwise = 'd' |
|
|
|
dumbConvert RotateCounterclockwise = 'k' |
|
|
|
smartConvert _ [] = Nothing |
|
|
|
smartConvert cmds (p:ps) = |
|
|
|
let (encoded, word) = p |
|
|
|
in if encoded `List.isPrefixOf` cmds |
|
|
|
then Just word |
|
|
|
else smartConvert cmds ps |