EndGameOld.hs

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Game.Hanabi.Strategies.EndGameOld(endGameMoveOld, EndGameOld(..), EndGameMirrorOld(..), egmo) where
import Game.Hanabi
import Data.List(maximumBy, delete)
import Data.Function(on)

-- | @'EGS' f p ps@ usually behaves based on @p@, but it conducts the exhaustive search assuming that others behave based on @ps@ when the deck size is @f@ or below @f@.
--   @move pvs mvs (EGO f p ps)@ may cause an error if @p@ can choose an invalid move.
data EndGameOld p ps = EGO {fromWhen::PublicInfo->Bool, myUsualStrategy::p, otherPlayers::ps}

instance (Monad m, Strategy p m, Strategies ps m) => Strategy (EndGameOld p ps) m where
  strategyName ms = return "EndGameOld"
  move pvs@(pv:_) mvs str@(EGO f p ps) | f (publicView pv)            = do (defaultMove, _) <- move pvs mvs p
                                                                           m <- endGameMoveOld pvs mvs (ps, [EGO f p ps]) $ defaultMove : delete defaultMove (effectiveMoves pv)
                                                                           return (m,str)
                                       | otherwise                    = do (m,_) <- move pvs mvs p
                                                                           return (m,str)

-- | 'EndGameMirrorStrategy' assumes that other players think in the same way as itself during endgame.
--   @move pvs mvs (EGMO (EGO f p ps))@ may cause an error if @p@ can choose an invalid move.
data EndGameMirrorOld p = EGMO (EndGameOld p [EndGameMirrorOld p])
egmo :: (PublicInfo -> Bool) -- ^ from when to start the endgame search
     -> p                    -- ^ the default strategy used until endgame
     -> Int                  -- ^ number of players, including the resulting player
     -> EndGameMirrorOld p
egmo from p nump = egmo where egmo = EGMO (EGO from p $ replicate (pred nump) egmo)

instance (Monad m, Strategy p m) => Strategy (EndGameMirrorOld p) m where
  strategyName ms = return "EndGameMirrorOld"
  move pvs mvs (EGMO egs) = do (m, egs') <- move pvs mvs egs
                               return (m, EGMO egs')

endGameMoveOld :: (Monad m, Strategies ps m) =>
               [PrivateView] -- ^ view history
               -> [Move]     -- ^ move history
               -> ps
               -> [Move]     -- ^ move candidates. More promising moves appear earlier.
               -> m Move
endGameMoveOld pvs@(pv:tlpvs) mvs ps candidates = do
                                        let states = possibleStates pv
                                        scores <- mapM (evalMove states (map publicView tlpvs) mvs ps) candidates
                                        let asc = zip scores candidates
                                            pub = publicView pv
                                            achievable = moreStrictlyAchievableScore pub
                                            --  ToDo:  Also consider critical cards at the bottom deck.
                                        return $ case lookup (achievable * length states) asc of Nothing -> snd $ maximumBy (compare `on` fst) $ reverse asc
                                                                                                 Just k  -> k -- Stop search when the best possible score is found.
evalMove :: (Monad m, Strategies ps m) => [(State, Int)] -> [PublicInfo] -> [Move] -> ps -> Move -> m Int
evalMove states pubs@(pub:_) mvs ps mv = fmap (sum . map (\(((eg,st:_,_),_),n) -> n * egToInt st eg)) $ mapM (\(st,n) -> fmap (\a->(a,n)) $ tryAMove (stateToStateHistory pubs mvs st) mvs ps mv) states

-- | 'tryAMove' tries a 'Move' and then simulate the game to the end, using given 'Strategies'. Running this with empty history, such as @tryAMove [st] [] strs m@ is possible, but that assumes other strategies does not depend on the history.
tryAMove :: (Monad m, Strategies ps m) => [State] -> [Move] -> ps -> Move -> m ((EndGame, [State], [Move]),ps)
tryAMove states@(st:_) mvs strs mov = case proceed st mov of Nothing -> error $ show mov ++ ": invalid move!"
                                                             Just st -> let nxt = rotate 1 st
                                                                        in case checkEndGame $ publicState nxt of Nothing -> runSilently (nxt:states) (mov:mvs) strs
                                                                                                                  Just eg -> return ((eg, nxt:states, mov:mvs), strs)