hanabi-dealer 0.8.0.0 → 0.9.0.0

raw patch · 10 files changed

+229/−25 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• Game/Hanabi.hs +129/−12
• Game/Hanabi/Client.hs +3/−4
• Game/Hanabi/Strategies/EndGameSearch.hs +24/−0
• Game/Hanabi/Strategies/SimpleStrategy.hs +2/−2
• Game/Hanabi/Strategies/StatefulStrategy.hs +2/−2
• Game/Hanabi/Strategies/Stateless.hs +48/−0
• client.hs +5/−1
• hanabi-dealer.cabal +3/−3
• server.hs +5/−1

@@ -1,5 +1,13 @@ 	# Revision history for hanabi-dealer +	## 0.9.0.0 -- 2020-04-22++	* add end-game search++	* add Replay strategy for debugging++	* fix a bug preventing reducing the number of colors when using GUI+ 	## 0.8.0.0 -- 2020-04-11  	* assign unique numbers to cards on the deck.

@@ -5,20 +5,20 @@               prettyEndGame, isMoveValid, checkEndGame, help,               -- * Datatypes               -- ** The Class of Strategies-              Strategies, Strategy(..), StrategyDict(..), mkSD, DynamicStrategy, mkDS, mkDS', Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose, quiet,+              Strategies, Strategy(..), StrategyDict(..), mkSD, DynamicStrategy, mkDS, mkDS', Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose, quiet, Replay(..),               -- ** Audience               Peeker, peek,               -- ** The Game Specification-              GameSpec(..), defaultGS, Rule(..), defaultRule, isRuleValid, colors, handSize, setHandSize,+              GameSpec(..), defaultGS, Rule(..), defaultRule, isRuleValid, makeRuleValid, colors, handSize, setHandSize,               -- ** The Game State and Interaction History               Move(..), Index, State(..), PrivateView(..), PublicInfo(..), Result(..), EndGame(..),-              -- ** The Cards-              Card(..), Color(..), Number(..), Marks, Possibilities, Annotation(..), cardToInt, intToCard, readsColorChar, readsNumberChar,+              -- ** The Cards and Annotations+              Card(..), Color(..), Number(..), Marks, Possibilities, Annotation(..), cardToInt, intToCard, readsColorChar, readsNumberChar, colorToBitPos, numberToBitPos,               -- * Utilities               -- ** Hints               isCritical, isUseless, bestPossibleRank, achievedRank, isPlayable, isHinted, currentScore, achievableScore,               definitely, obviously,-              isMoreObviouslyUseless, isObviouslyUseless, isDefinitelyUseless, isDefinitelyUncritical, isDefinitelyCritical, isMoreObviouslyPlayable, isObviouslyPlayable, isDefinitelyPlayable, isObviouslyUnplayable, isDefinitelyUnplayable, obviousChopss, definiteChopss, isDoubleDrop, possibleCards,+              isMoreObviouslyUseless, isObviouslyUseless, isDefinitelyUseless, isDefinitelyUncritical, isDefinitelyCritical, isMoreObviouslyPlayable, isObviouslyPlayable, isDefinitelyPlayable, isObviouslyUnplayable, isDefinitelyUnplayable, obviousChopss, definiteChopss, isDoubleDrop, possibleCards, endGameMove, EndGameStrategy(..), EndGameMirrorStrategy(..), egms,               tryMove, (|||), ifA,               -- ** Legacy functions               givenHints, possibilities_until_Ver0720,@@ -32,7 +32,8 @@ import Control.Monad.IO.Class(MonadIO, liftIO) import Data.Char(isSpace, isAlpha, isAlphaNum, toLower, toUpper) import Data.Maybe(fromJust)-import Data.List(isPrefixOf, group)+import Data.List(isPrefixOf, group, maximumBy, delete)+import Data.Function(on) import System.IO import Data.Dynamic import Data.Bits hiding (rotate)@@ -124,8 +125,13 @@ --          x , multicolor     :: Bool   -- ^ multicolor play, or Variant 3               } deriving (Show, Read, Eq, Generic) isRuleValid :: Rule -> Bool-isRuleValid rl@R{..} = numBlackTokens > 0 && and [ h>0 && h<=mh | (h,mh) <- zip funPlayerHand maxPlayerHand ] && numColors>0 && numColors <=6 && (numColors < 6 || all (>0) numMulticolors)-  where maxPlayerHand = [ succ (numberOfCards rl) `div` numP | numP <- [2..]]+isRuleValid rl@R{..} = numBlackTokens > 0 && and [ h>0 && h<=mh | (h,mh) <- zip funPlayerHand $ maxPlayerHand rl ] && numColors>0 && numColors <=6 && (numColors < 6 || all (>0) numMulticolors)+makeRuleValid :: Rule -> Rule+makeRuleValid rl@R{..} = rl{numBlackTokens = max 1 numBlackTokens,+                            numColors = max 1 (min 6 numColors),+                            numMulticolors = if numColors<6 then numMulticolors else take 5 (map (max 1) numMulticolors ++ [1,1,1,1,1]),+                            funPlayerHand  = [ max 1 h | h <- zipWith min funPlayerHand $ maxPlayerHand rl ]}+maxPlayerHand rl = [ succ (numberOfCards rl) `div` numP | numP <- [2..]]         -- This makes sure that there is at least one card on the deck.  -- | @defaultRule@ is the normal rule from the rule book of the original card game Hanabi.@@ -192,6 +198,11 @@ -- | A 'Possibilities' is a pair of data that are instances of Bits. The first represents which colors are possible, and the second is for numbers. type Possibilities = (Int, Int) +colorToBitPos  :: Color -> Int+colorToBitPos  i = 5 - fromEnum i+numberToBitPos :: Number -> Int+numberToBitPos k = 5 - fromEnum k+ data Annotation = Ann {ixDeck :: Int                   -- ^ Index in the initial deck                       , marks :: Marks                 -- ^ The Number and Color hints given to the card.                       , possibilities :: Possibilities}@@ -340,6 +351,8 @@ #endif currentScore :: PublicInfo -> Int currentScore pub = sum [ fromEnum $ achievedRank pub k | k <- colors pub ]++-- | achievable score based on the info of extinct cards. achievableScore :: PublicInfo -> Int achievableScore pub = sum [ fromEnum $ bestPossibleRank pub k | k <- colors pub ] @@ -353,7 +366,7 @@  -- | 'Result' is the result of the last move. data Result = None -- ^ Hinted or at the beginning of the game-            | Discard Card | Success Card | Fail Card deriving (Read, Show, Eq, Generic)+            | Discard {revealed::Card} | Success {revealed::Card} | Fail {revealed::Card} deriving (Read, Show, Eq, Generic)  -- The view history [PrivateView] records the memory of what has been visible `as is'. That is, the info of the cards in the history is not updated by revealing them. -- I guess, sometimes, ignorance of other players might also be an important knowledge.@@ -374,6 +387,89 @@ instance Eq PrivateView where   PV pub1 hs1 _ == PV pub2 hs2 _ = (pub1,hs1) == (pub2,hs2) ++-- | recede rolls back 1 turn without rotating.+recede :: PublicInfo -> Move -> State -> State+recede lastpub (Hint _ _) st = st{ publicState = lastpub }+recede lastpub mv         st = St{ publicState = lastpub,+                                   pile        = if pileNum lastpub == 0 then [] else (head myHand, initAnn (gameSpec lastpub) $ ixDeck $ head $ head $ annotations $ publicState st) : pile st,+                                   hands       = case splitAt (index mv) $ if pileNum lastpub == 0 then myHand else tail myHand of (tk,dr) -> (tk ++ revealed (result $ publicState st) : dr) : tail (hands st)}+  where myHand = head $ hands st+-- | stateToStateHistory deduces the state history from the 'PublicState' history, the 'Move' history, and the current 'State'.+stateToStateHistory :: [PublicInfo] -> [Move] -> State -> [State]+stateToStateHistory []       []       st = [st]+stateToStateHistory (pi:pis) (mv:mvs) st = st : stateToStateHistory pis mvs (rotate (-1) $ recede pi mv st)++-- | @'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@.+data EndGameStrategy p ps = EGS {fromWhen::PublicInfo->Bool, myUsualStrategy::p, otherPlayers::ps}++instance (Monad m, Strategy p m, Strategies ps m) => Strategy (EndGameStrategy p ps) m where+  strategyName ms = return "EndGameStrategy"+  move pvs@(pv:_) mvs str@(EGS f p ps) | f (publicView pv)            = do (defaultMove, _) <- move pvs mvs p+                                                                           m <- endGameMove pvs mvs (ps, [EGS f p ps]) $ defaultMove : delete defaultMove (validMoves 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.+data EndGameMirrorStrategy p = EGMS (EndGameStrategy p [EndGameMirrorStrategy p])+egms :: (PublicInfo -> Bool) -- ^ from when to start the endgame search+     -> p                    -- ^ the default strategy used until endgame+     -> Int                  -- ^ number of players, including the resulting player+     -> EndGameMirrorStrategy p+egms from p nump = egms where egms = EGMS (EGS from p $ replicate (pred nump) egms)++instance (Monad m, Strategy p m) => Strategy (EndGameMirrorStrategy p) m where+  strategyName ms = return "EndGameMirrorStrategy"+  move pvs mvs (EGMS egs) = do (m, egs') <- move pvs mvs egs+                               return (m, EGMS egs')++endGameMove :: (Monad m, Strategies ps m) =>+               [PrivateView] -- ^ view history+               -> [Move]     -- ^ move history+               -> ps+               -> [Move]     -- ^ move candidates. More promising moves appear earlier.+               -> m Move+endGameMove 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 = if prolong $ rule $ gameSpec pub then achievableScore pub else achievableScore pub `min` (currentScore pub + pileNum pub + numPlayers (gameSpec 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.++validMoves :: PrivateView -> [Move]+validMoves pv@PV{publicView=pub@PI{gameSpec=gs,hintTokens=hints},handsPV=tlHands}+  = map Play [0 .. pred myHandSize] ++ (if hints > 0 then ([ Hint hintedpl eck | hintedpl <- [1 .. numPlayers gs - 1], eck <- map Left (colors pub) ++ map Right [K1 .. K5], not (null $ filter (either (\c -> (==c).color) (\k -> (==k).number) eck) (tlHands !! pred hintedpl)) ] ++) else id) (if hints < 8 then (map Drop [0 .. pred myHandSize]) else [])+                  where myHandSize = length (head $ annotations pub)++evalMove :: (Monad m, Strategies ps m) => [State] -> [PublicInfo] -> [Move] -> ps -> Move -> m Int+evalMove states pubs@(pub:_) mvs ps mv = fmap (sum . map (\((eg,_,_),_) -> egToInt pub eg)) $ mapM (\st -> 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 -> fail $ 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)++possibleStates :: PrivateView -> [State]+possibleStates pv@PV{publicView=pub@PI{gameSpec=gs}}+  = [ St{ publicState = pub+        , pile = zipWith (\c i -> (c, initAnn gs i)) deck [ (numberOfCards (rule $ gameSpec pub) - pileNum pub) ..]+        , hands = hand : handsPV pv }+    | (hand, deck) <- possiblePermutations pv ]+possiblePermutations :: PrivateView -> [([Card],[Card])]+possiblePermutations pv@PV{publicView=PI{annotations=anns:_}} = possiblePerms anns (invisibleCards pv)+invisibleCards :: PrivateView -> [Card]+invisibleCards PV{publicView=PI{annotations=anns}, invisibleBag=inv} = [ c | (k,v) <- IM.toList inv, c <- replicate v $ intToCard k ] -- x ++ [ C i k | (Just i, Just k) <- map marks anns ]+possiblePerms :: [Annotation] -> [Card] -> [([Card],[Card])]+possiblePerms [] cards = [([],cards)]+possiblePerms (Ann{marks = (Just i, Just k)} : anns) cards = [ (C i k : hand, deck) | (hand, deck) <- possiblePerms anns cards ]+possiblePerms (Ann{possibilities = (pi, pk)} : anns) cards = [ (card : hand, deck) | card@(C i k) <- cards, (pi .&. bit (colorToBitPos i)) * (pk .&. bit (numberToBitPos k)) /= 0, (hand, deck) <- possiblePerms anns $ delete card cards ]+ -- | 'mkPV' is the constructor of PrivateView. mkPV :: PublicInfo -> [[Card]] -> PrivateView mkPV pub hs = PV pub hs $ foldr (IM.update (Just . pred)) (nonPublic pub) $ map cardToInt $ concat $ [ C c n | Ann{marks=(Just c, Just n)} <- head $ annotations pub ] : hs@@ -544,6 +640,13 @@                               case mbeg of Nothing -> run audience sts mvs ps                                            Just eg -> return ((eg, sts, mvs), ps) +-- | 'runSilently' is a light variant of 'run' that does not broadcast the process. This is useful for simulating the game within a strategy.+runSilently :: (Monad m, Strategies ps m) => [State] -> [Move] -> ps -> m ((EndGame, [State], [Move]), ps)+runSilently states moves players = do+                              ((mbeg, sts, mvs), ps) <- runARound (\_ _ -> return ()) states moves players+                              case mbeg of Nothing -> runSilently sts mvs ps+                                           Just eg -> return ((eg, sts, mvs), ps)+ -- | The 'Strategy' class is exactly the interface that --   AI researchers defining their algorithms have to care about. class Monad m => Strategy p m where@@ -691,6 +794,15 @@ ithPlayerFromTheLast :: Int -> Int -> String ithPlayerFromTheLast nump j = "The " ++ ith (nump-j) ++"last player's" ++newtype Replay = Replay String deriving (Read, Show)+instance (MonadIO m) => Strategy Replay m where+  strategyName _ = return "Replay"+  move (v:_) _ (Replay xs) = case splitAt 2 xs of ("","") -> do mov <- liftIO $ repeatReadingAMoveUntilSuccess stdin stdout v+                                                                return (mov, Replay "")+                                                  (tk,dr) -> return (read tk, Replay dr)++ type STDIO = Verbose Blind stdio :: Verbose Blind stdio = Verbose Blind verbose@@ -714,7 +826,7 @@  -- | 'createGameFromCards' deals cards and creates the initial state. createGameFromCards :: GameSpec -> [Card] -> State-createGameFromCards gs cards = splitCons (numPlayers gs) [] [ (c, Ann{ixDeck=i, marks=(Nothing, Nothing), possibilities=unknown gs}) | (c,i) <- zip cards [0..] ]+createGameFromCards gs cards = splitCons (numPlayers gs) [] [ (c, initAnn gs i) | (c,i) <- zip cards [0..] ]            where splitCons 0 hnds stack                    = St {publicState = PI {gameSpec   = gs,                                             pileNum    = initialPileNum gs,@@ -733,6 +845,7 @@                            hands = map (map fst) hnds                           }                  splitCons n hnds stack = case splitAt (handSize gs) stack of (tk,dr) -> splitCons (pred n) (tk:hnds) dr+initAnn gs i = Ann{ixDeck=i, marks=(Nothing, Nothing), possibilities=unknown gs} createGame :: RandomGen g => GameSpec -> g -> (State, g) -- Also returns the new RNG state, in order not to require safe 'split' for collecting statistics. RNG is only used for initial shuffling. createGame gs gen = (createGameFromCards gs shuffled, g) where                  (shuffled, g) = createDeck (rule gs) gen@@ -823,10 +936,10 @@           zipper (C ir ka) ann@Ann{marks=(mi,mk),possibilities=(c,n)}             = case eik of Left  i | i == ir -> ann{marks=(Just i, mk), possibilities = (bit ibit, n)}                                   |otherwise-> ann{possibilities = (clearBit c ibit, n)}-                            where ibit = 5 - fromEnum i+                            where ibit = colorToBitPos i                           Right k | k == ka -> ann{marks=(mi, Just k), possibilities = (c, bit kbit)}                                   |otherwise-> ann{possibilities = (c, clearBit n kbit)}-                            where kbit = 5 - fromEnum k+                            where kbit = numberToBitPos k   -- | @'rotate' num@ rotates the first person by @num@ (modulo the number of players).@@ -838,6 +951,10 @@ -- | 'EndGame' represents the game score, along with the info of how the game ended. --   It is not just @Int@ in order to distinguish 'Failure' (disaster / no life) from @'Soso' 0@ (not playing any card), though @'Soso' 0@ does not look more attractive than 'Failure'. data EndGame = Failure | Soso Int | Perfect deriving (Show,Read,Eq,Generic)++egToInt _   Failure  = 0+egToInt _   (Soso n) = n+egToInt pub Perfect  = 5 * numColors (rule $ gameSpec pub)  checkEndGame :: PublicInfo -> Maybe EndGame checkEndGame pub | lives pub == 0                                      = Just Failure

@@ -85,7 +85,7 @@                            defStr = maybe "via WebSocket" id $ lookup "strategy" query                        mvStr <- liftIO newMVarStrategy                        startApp App{-    model  = Model{tboxval = Message "available", players = [S.pack defStr], from = Just 0, rule = defaultRule{numMulticolors=replicate 5 1}, received = [], fullHistory = False, showVerbosity = False, verbosity = verbose, play = True, localStrategy = mvStr, local = False},+    model  = Model{tboxval = Message "available", players = [S.pack defStr], from = Just 0, rule = defaultRule{numMulticolors=replicate 5 1}, received = [CreateGame], fullHistory = False, showVerbosity = False, verbosity = verbose, play = True, localStrategy = mvStr, local = False},     update = updateModel options,     view   = appView strNames $ version options,     subs   = [ websocketSub wsURI protocols HandleWebSocket ],@@ -151,7 +151,7 @@                                                      ns            -> ns                                                  } updateModel _ (UpdatePlayer ix pl) model = noEff model{players = snd $ replaceNth ix pl $ players model}-updateModel _ (UpdateRule r)    model | isRuleValid r = noEff model{rule=r}+updateModel _ (UpdateRule r)    model = noEff model{rule=makeRuleValid r} updateModel _ (UpdateVerbosity v) model = noEff model{verbosity = v} updateModel _ Toggle            model = noEff model{fullHistory = not $ fullHistory model} updateModel _ ToggleVerbosity   model = noEff model{showVerbosity = not $ showVerbosity model}@@ -259,8 +259,7 @@   , span_ [style_ $ M.fromList [("clear","both"), ("font-size","10px"), ("float","right")]] [text $ S.pack $ "hanabi-dealer client "++versionInfo] -- , hr_ []- , div_ [style_ $ M.fromList [("clear","both")]] $ if null received then renderCreateGame strategies mdl-                                                                    else ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbosity mdl) received)+ , div_ [style_ $ M.fromList [("clear","both")]] $ ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbosity mdl) received)  , div_ [] $ if null $ drop lenShownHistory received then [] else [      hr_ []    , input_ [ type_ "checkbox", id_ "showhist", onClick Toggle, checked_ fullHistory]

@@ -0,0 +1,24 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Game.Hanabi.Strategies.EndGameSearch where+import Game.Hanabi hiding (main)+import Game.Hanabi.Strategies.Stateless hiding (main)+import Game.Hanabi.Strategies.SimpleStrategy hiding (main)+import System.Random++-- A strategy with endgame search+data EndGameSearch = EG++instance (Monad m) => Strategy EndGameSearch m where+  strategyName ms = return "EndGame"+  move pvs@(pv:_) mvs EG = do (m, _) <- -- move (sontakuColorHint pvs mvs) mvs $ searchExhaustively SL+                                        -- move (sontakuColorHint pvs mvs) mvs $ assumeOthersAreSL SL+                                        move (sontakuColorHint pvs mvs) mvs $ searchExhaustively $ assumeOthersAreSL SL+                              return (m, EG)+                              where searchExhaustively fallback = egms (\pub -> pileNum pub == 0) fallback (numPlayers $ gameSpec $ publicView pv)+                                    assumeOthersAreSL  fallback = EGS (\pub -> pileNum pub <= 1 && hintTokens pub <= 4) fallback $ replicate (pred $ numPlayers $ gameSpec $ publicView pv) SL+--                                    assumeOthersAreSL  fallback = EGS (\pub -> pileNum pub <=2 && hintTokens pub <= 4) fallback $ replicate (pred $ numPlayers $ gameSpec $ publicView pv) SL+--                                    assumeOthersAreSL  fallback = EGS (\pub -> pileNum pub + hintTokens pub < 4) fallback $ replicate (pred $ numPlayers $ gameSpec $ publicView pv) SL+main = do g <- newStdGen+          ((eg,_),_) <- start defaultGS [] ([EG], [stdio]) g -- Play it with standard I/O (human player).+--          ((eg,_),_) <- start defaultGS [peek] [EG, EG] g -- Play it with itself.+          putStrLn $ prettyEndGame eg

@@ -29,8 +29,8 @@                                                                                           isNewestOfColor i d ] -- but be cautious not to color-mark newer cards.                            colorMarkNumberMarkedPlayable = take 1 [ Hint 1 $ Left $ color d | (_,d,Ann{marks=(Nothing, Just _)}) <- markCandidates ]   -- Mark the color if a (not obviously) playable card is only number-marked.                            numberMarkPlayable = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{marks=(_, Nothing)}) <- markCandidates ] -- Mark the number if a (not obviously) playable card is not number-marked.-                           numberMarkUselessIfInformative = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{possibilities=p@(pc, _)}) <- nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (pc, bit $ 5 - fromEnum (number d)) ]-                           colorMarkUselessIfInformative = take 1 [ Hint 1 $ Left $ color d | (i,d,Ann{possibilities=p@(_, pn)}) <- reverse nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (bit $ 5 - fromEnum (color d), pn),+                           numberMarkUselessIfInformative = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{possibilities=p@(pc, _)}) <- nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (pc, bit $ numberToBitPos (number d)) ]+                           colorMarkUselessIfInformative = take 1 [ Hint 1 $ Left $ color d | (i,d,Ann{possibilities=p@(_, pn)}) <- reverse nextPlayer, not $ isObviouslyUseless pub p, isObviouslyUseless pub (bit $ colorToBitPos (color d), pn),                                                                                               isNewestOfColor i d ] -- but be cautious not to color-mark newer cards.                            numberMarkUnmarked       = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{marks=(Nothing, Nothing),possibilities=p}) <- nextPlayer, not $ isObviouslyUseless pub p ]                            numberMarkNumberUnmarked = take 1 [ Hint 1 $ Right $ number d | (_,d,Ann{marks=(Just _, Nothing),possibilities=p}) <- nextPlayer, not $ isObviouslyUseless pub p ]

@@ -26,13 +26,13 @@                             hintedColors = [ c | (p, Hint q (Left c)) <- zip [1..] $ take (numPlayers $ gameSpec pub) mvs,                                                 p==q,-                                                (Just c, Just $ succ $ achievedRank pub c) `notElem` map marks myAnns  -- Exclude if there is a playable card with the color.+                                                not $ or [ isObviouslyPlayable pub m | Ann{marks=(Just i, _),possibilities=m} <- myAnns, c==i ] -- Exclude if there is a playable card with the color.                                               ]                            hintedAnns = [ ann{possibilities = (fst $ possibilities ann, newNumberPos)}                                                 | c <- hintedColors,                                                   let i   = length $ takeWhile ((/=Just c) . fst . marks) myAnns                                                       ann = myAnns !! i-                                                      newNumberPos = bit $ 4 - fromEnum (achievedRank pub c), -- This is -1 when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.+                                                      newNumberPos = bit $ numberToBitPos (succ $ achievedRank pub c), -- This is undefined when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.                                                   not $ isDefinitelyUnplayable pv ann,                                                   newNumberPos .&. snd (possibilities ann) /= 0 ]                            pub = publicView pv

@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Game.Hanabi.Strategies.Stateless where+import Game.Hanabi hiding (main)+import Game.Hanabi.Strategies.SimpleStrategy+import System.Random+import Data.Maybe(isNothing)+import Data.List(sortOn)+import Data.Bits(bit, (.&.))+import qualified Data.IntMap as IM++-- A stateless implementation of Stateful+data Stateless = SL++lookupOn :: Eq b => (a -> b) -> a -> [a] -> [a]+lookupOn fun key xs = [ result | result <- xs, fun key == fun result ]++sontakuColorHint :: [PrivateView] -> [Move] -> [PrivateView]+sontakuColorHint pvs@(pv:_) mvs = let+                           consistentGuess = [ case lookupOn ixDeck realAnn hintedAnns of+                                                 guessedAnn:_ -> guessedAnn+                                                 _            -> realAnn+                                             | realAnn <- myAnns ]+                           hintedAnns = [ ann{possibilities = (currentColPos, newNumberPos)}+                                        | Ann{ixDeck=ix, marks=(Just c, Nothing), possibilities=(currentColPos, currentNumPos)} <- myAnns+                                        , (p,pvInQ,c) <- take 1 [ (p,pvq,c) | (p, pvq, Hint q (Left d)) <- zip3 [1..] pvs mvs,+                                                                  c==d  &&  p `mod` numPlayers (gameSpec pub) == q ]+                                        , let pubInQ = publicView pvInQ+                                              myAnnsInQ = head $ annotations pubInQ+                                        , not $ or [ isObviouslyPlayable pubInQ m | Ann{marks=(Just i, _),possibilities=m} <- myAnnsInQ, c==i ] -- Exclude if there is a playable card with the color.++                                        , ann <- take 1 [ ann | ann@Ann{marks=(Just i,_)} <- myAnnsInQ, c==i ]+                                        , let newNumberPos = bit $ numberToBitPos (succ $ achievedRank pubInQ c) -- This is undefined when achievedRank pub c == K5, but then isDefinitelyUnplayable pv ann should be True.+                                        , ixDeck ann == ix++                                        , not $ isDefinitelyUnplayable pvInQ ann+                                        , newNumberPos .&. currentNumPos /= 0 ]+                           pub = publicView pv+                           myAnns = head $ annotations pub+                       in pv{publicView=pub{annotations=consistentGuess : tail (annotations pub)}} : tail pvs++instance Monad m => Strategy Stateless m where+  strategyName ms = return "Stateless"+  move pvs@(pv:_) mvs SL = move (sontakuColorHint pvs mvs) mvs S >>= \(mov,S) -> return (mov, SL)++main = do g <- newStdGen+          ((eg,_),_) <- start defaultGS [] ([SL],[stdio]) g -- Play it with standard I/O (human player).+--          ((eg,_),_) <- start defaultGS [peek] [SL,SL] g -- Play it with itself.+          putStrLn $ prettyEndGame eg

@@ -3,12 +3,16 @@  import Game.Hanabi.Strategies.SimpleStrategy hiding (main) import Game.Hanabi.Strategies.StatefulStrategy hiding (main)+import Game.Hanabi.Strategies.Stateless hiding (main)+import Game.Hanabi.Strategies.EndGameSearch hiding (main)  main = client defOpt{strategies=strs}  -- strs :: [(String, IO (DynamicStrategy IO))] strs = [      ("Stupid example strategy", return $ mkDS "Stupid example strategy" $ S),-     ("Example strategy with states", return $ mkDS "Example strategy with states" $ SF [])+     ("Example strategy with states", return $ mkDS "Example strategy with states" $ SF []),+     ("Stateless implementation of the strategy with states", return $ mkDS "Stateless implementation of the strategy with states" SL),+     ("Strategy with end game search", return $ mkDS "Strategy with end game search" EG)  -- x , ("Sontakki", return $ mkDS "Sontakki" (Sontakki emptyDefault))   ]

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.8.0.0+version:             0.9.0.0  -- A short (one-line) description of the package. synopsis:            Hanabi card game@@ -156,7 +156,7 @@  executable hanabib   main-is:       server.hs-  other-modules: Game.Hanabi.Strategies.SimpleStrategy, Game.Hanabi.Strategies.StatefulStrategy+  other-modules: Game.Hanabi.Strategies.SimpleStrategy, Game.Hanabi.Strategies.StatefulStrategy, Game.Hanabi.Strategies.Stateless, Game.Hanabi.Strategies.EndGameSearch   if impl(ghcjs) || !flag(server)     buildable: False   else@@ -180,7 +180,7 @@  executable hanabif   main-is:       client.hs-  other-modules: Game.Hanabi.Strategies.SimpleStrategy, Game.Hanabi.Strategies.StatefulStrategy+  other-modules: Game.Hanabi.Strategies.SimpleStrategy, Game.Hanabi.Strategies.StatefulStrategy, Game.Hanabi.Strategies.Stateless, Game.Hanabi.Strategies.EndGameSearch   if !impl(ghcjs) --                 && !flag(jsaddle)     buildable: False

@@ -3,12 +3,16 @@  import Game.Hanabi.Strategies.SimpleStrategy hiding (main) import Game.Hanabi.Strategies.StatefulStrategy hiding (main)+import Game.Hanabi.Strategies.Stateless hiding (main)+import Game.Hanabi.Strategies.EndGameSearch hiding (main)  main = server defOpt{strategies=strs}  strs :: [(String, IO (DynamicStrategy IO))] strs = [      ("Stupid example strategy", return $ mkDS "Stupid example strategy" S),-     ("Example strategy with states", return $ mkDS "Example strategy with states" $ SF [])+     ("Example strategy with states", return $ mkDS "Example strategy with states" $ SF []),+     ("Stateless implementation of the strategy with states", return $ mkDS "Stateless implementation of the strategy with states" SL),+     ("Strategy with end game search", return $ mkDS "Strategy with end game search" EG)  -- x , ("Sontakki", return $ mkDS "Sontakki" (Sontakki emptyDefault))   ]