diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for hanabi-dealer +## 0.2.1.0 -- 2020-01-04 + +* introduce isPlayable + +* fix several misfeatures + ## 0.2.0.0 -- 2019-12-20 * define the Verbosity option diff --git a/Game/Hanabi.hs b/Game/Hanabi.hs --- a/Game/Hanabi.hs +++ b/Game/Hanabi.hs @@ -1,22 +1,22 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Safe #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Safe, DeriveGeneric #-} module Game.Hanabi( -- * Functions for Dealing Games main, selfplay, start, createGame, run, prettyEndGame, isMoveValid, checkEndGame, help, -- * Datatypes -- ** The Class of Strategies - Strategies, Strategy(..), Verbose(..), STDIO, Blind, ViaHandles(..), Verbosity(..), verbose, + Strategies, Strategy(..), Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose, -- ** The Game Specification GameSpec(..), defaultGS, Rule(..), defaultRule, -- ** The Game State and Interaction History - Move(..), Index, State(..), PrivateView(..), PublicInfo(..), EndGame(..), + Move(..), Index, State(..), PrivateView(..), PublicInfo(..), Result(..), EndGame(..), -- ** The Cards Card(..), Color(..), Number(..), cardToInt, intToCard, readsColorChar, readsNumberChar, -- * Utilities -- ** Hints - isCritical, isUseless, bestPossibleRank, + isCritical, isUseless, bestPossibleRank, isPlayable, -- ** Minor ones - what'sUp, what'sUp1, ithPlayer) where + what'sUp, what'sUp1, ithPlayer, recentEvents, prettyPI, ithPlayerFromTheLast, view) where -- module Hanabi where import qualified Data.IntMap as IM import System.Random @@ -26,11 +26,15 @@ import Data.List(isPrefixOf, group) import System.IO -data Number = Empty | K1 | K2 | K3 | K4 | K5 deriving (Eq, Ord, Show, Read, Enum, Bounded) +import GHC.Generics hiding (K1) + +data Number = Empty | K1 | K2 | K3 | K4 | K5 deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) data Color = White | Yellow | Red | Green | Blue | Multicolor - deriving (Eq, Show, Read, Enum) + deriving (Eq, Show, Read, Enum, Generic) readsColorChar :: ReadS Color -readsColorChar (c:str) = case lookup (toUpper c) [(head $ show i, i) | i <- [White, Yellow, Red, Green, Blue]] of +readsColorChar (c:str) + | isSpace c = readsColorChar str + | otherwise = case lookup (toUpper c) [(head $ show i, i) | i <- [White, Yellow, Red, Green, Blue]] of Nothing -> [] Just i -> [(i, str)] readsColorChar [] = [] @@ -38,7 +42,7 @@ readsNumberChar ('0':rest) = [(Empty,rest)] readsNumberChar str = reads ('K':str) -data Card = C {color :: Color, number :: Number} deriving Eq +data Card = C {color :: Color, number :: Number} deriving (Eq, Generic) instance Show Card where showsPrec _ (C color number) = (head (show color) :) . (show (fromEnum number) ++) instance Read Card where @@ -50,17 +54,19 @@ data Move = Drop {index::Index} -- ^ drop the card (0-origin) | Play {index::Index} -- ^ play the card (0-origin) | Hint Int (Either Color Number) -- ^ give hint to the ith next player + deriving (Eq, Generic) instance Show Move where showsPrec _ (Drop i) = ("Drop"++) . shows i showsPrec _ (Play i) = ("Play"++) . shows i - showsPrec _ (Hint i eith) = ("Hint"++) . shows i . (either shows (\k -> tail . shows k) eith) + showsPrec _ (Hint i eith) = ("Hint"++) . shows i . (either (\i -> (take 1 (show i) ++)) (\k -> tail . shows k) eith) instance Read Move where readsPrec _ str - = let (cmd,other) = span (not.isSpace) str + = let (cmd,other) = span (not.isSpace) str' + str' = dropWhile isSpace str in case span (not . (`elem` "dDpP")) cmd of (tk, d:dr) | all (not.isAlphaNum) tkdr && null (drop 1 $ group tkdr) -> [((if toLower d == 'd' then Drop else Play) $ length tk, other)] where tkdr = tk++dr - _ -> case span isAlpha str of + _ -> case span isAlpha str' of (kw, xs) | kwl `isPrefixOf` "hint" -> parseHint xs -- Since kwl can be "", "11" parses as "Hint11". | kwl `isPrefixOf` "drop" -> [(Drop i, rest) | (i, rest) <- reads xs] | kwl `isPrefixOf` "play" -> [(Play i, rest) | (i, rest) <- reads xs] @@ -94,17 +100,17 @@ -- -- See also the definition of 'checkEndGame'. data Rule = R { numBlackTokens :: Int -- ^ E.g., if this is 3, the third failure ends the game with failure. - , funPlayerHand :: [Int] -- ^ memoized function taking the number of players; the default is [5,5,4,4]++repeat 4 + , funPlayerHand :: [Int] -- ^ memoized function taking the number of players; the default is [5,5,4,4,4,4,4,4,4,4,4,4,4,4] , numColors :: Int -- ^ number of colors. 5 for the normal rule, and 6 for Variant 1-3 of the rule book. , prolong :: Bool -- ^ continue even after a round after the pile is exhausted. @True@ for Variant 4 of the rule book. , numMulticolors :: [Int] -- ^ number of each of multicolor cards. @[3,2,2,2,1]@ for Variant 1 (and Variant 3?), and @[1,1,1,1,1]@ for Variant 2. -- x , multicolor :: Bool -- ^ multicolor play, or Variant 3 - } deriving (Show, Read) + } deriving (Show, Read, Eq, Generic) -- | @defaultRule@ is the normal rule from the rule book of the original card game Hanabi. defaultRule = R { numBlackTokens = 3 - , funPlayerHand = [5,5]++repeat 4 + , funPlayerHand = [5,5]++take 12 (repeat 4) , numColors = 5 , prolong = False , numMulticolors = replicate 5 0 @@ -114,7 +120,7 @@ initialPileNum gs = sum (take (numColors $ rule gs) $ [10,10,10,10,10]++[sum (numMulticolors $ rule gs)]) - numPlayerHand gs * numPlayers gs numPlayerHand gs = funPlayerHand (rule gs) !! (numPlayers gs - 2) -data GameSpec = GS {numPlayers :: Int, rule :: Rule} deriving (Read, Show) +data GameSpec = GS {numPlayers :: Int, rule :: Rule} deriving (Read, Show, Eq, Generic) -- | State consists of all the information of the current game state, including public info, private info, and the hidden deck. data State = St { publicState :: PublicInfo @@ -122,7 +128,7 @@ , hands :: [[Card]] -- ^ partly invisible list of each player's hand. -- In the current implementation (arguably), this represents [current player's hand, next player's hand, second next player's hand, ...] -- and this is rotated every turn. - } deriving (Read, Show) + } deriving (Read, Show, Eq, Generic) -- | PublicInfo is the info that is available to all players. data PublicInfo = PI { gameSpec :: GameSpec @@ -148,7 +154,7 @@ -- Negative hints should also be implemented, but they should be kept separate from givenHints, -- in order to guess the behavior of algorithms that do not use such information. , result :: Result -- ^ The result of the last move. This info may be separated from 'PublicInfo' in future. - } deriving (Read, Show) + } deriving (Read, Show, Eq, Generic) @@ -170,12 +176,13 @@ isCritical pub card = not (isUseless pub card) && succ (discarded pub IM.! cardToInt card) == (numCards (gameSpec pub) (color card) !! (pred $ fromEnum $ number card)) - +isPlayable :: PublicInfo -> Card -> Bool +isPlayable pub card = pred (number card) == played pub IM.! fromEnum (color card) -- | '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) + | Discard Card | Success Card | Fail 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. @@ -189,7 +196,7 @@ -- and the view history @[PrivateView]@ must be from the same player's viewpoint (as the matter of course). , invisibleBag :: IM.IntMap Int -- ^ @'Card' -> Int@. This represents the bag of unknown cards (which are either in the pile or in the player's hand). -- This can be computed from publicView and handsSV. - } deriving (Read, Show) + } deriving (Read, Show, Eq, Generic) prettyPV :: Verbosity -> PrivateView -> String prettyPV v pv@PV{publicView=pub} = prettyPI pub ++ "\nMy hand:\n" ++ concat (replicate (length myHand) " __") ++ "\n" @@ -200,13 +207,16 @@ ++ concat (zipWith3 (prettyHand v pub (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (handsPV pv) $ tail $ givenHints pub) where myHand = head (givenHints pub) prettySt ithP st@St{publicState=pub} = prettyPI pub ++ concat (zipWith3 (prettyHand verbose pub (ithP $ numPlayers $ gameSpec pub)) [0..] (hands st) $ givenHints pub) -verbose = V{warnCritical=True,markUseless=True,markHints=True} +verbose = V{warnCritical=True,markUseless=True,markPlayable=True,markHints=True} prettyHand :: Verbosity -> PublicInfo -> (Int->String) -> Int -> [Card] -> [(Maybe Color, Maybe Number)] -> String prettyHand v pub ithPnumP i cards hl = "\n\n" ++ ithPnumP i ++ " hand:\n" -- ++ concat (replicate (length cards) " __") ++ " \n" - ++ concat [ if warnCritical v && tup==(Nothing,Nothing) && isCritical pub card then " !!" - else if markUseless v && isUseless pub card then " .." - else " __" + ++ concat [ if markUseless v && isUseless pub card then " .." + else case (warnCritical v && tup==(Nothing,Nothing) && isCritical pub card, markPlayable v && isPlayable pub card) of + (True, True) -> " !^" + (True, False) -> " !!" + (False,True) -> " _^" + (False,False) -> " __" | (card, tup) <- zip cards hl ] ++"\n" ++ concat [ '|':show card | card <- cards ] ++"|\n" ++ (if markHints v then showHintLine hl else "") @@ -216,10 +226,11 @@ showHintLine hl = '|' : concat [ maybe ' ' (head . show) mc : maybe ' ' (head . show . fromEnum) mk : "|" | (mc,mk) <- hl] ++ "\n" -- | 'Verbosity' is the set of options used by verbose 'Strategy's -data Verbosity = V { warnCritical :: Bool -- ^ mark unhinted critical cards with "!!" +data Verbosity = V { warnCritical :: Bool -- ^ mark unhinted critical cards with "!!" ("!^" if it is playable and markPlayable==True.) , markUseless :: Bool -- ^ mark useless cards with ".." + , markPlayable :: Bool -- ^ mark playable cards with "_^". ("!^" if it is unhinted critical and warnCritical==True.) , markHints :: Bool -- ^ mark hints - } deriving (Read, Show) + } deriving (Read, Show, Eq, Generic) prettyPI pub @@ -258,6 +269,7 @@ putStrLn $ prettyEndGame finalSituation -- | 'prettyEndGame' can be used to pretty print the final situation. +prettyEndGame :: (EndGame, [State], [Move]) -> String prettyEndGame (eg,sts@(st:_),mvs) = unlines $ recentEvents ithPlayerFromTheLast (map view sts) mvs : replicate 80 '!' : @@ -359,7 +371,7 @@ return $ if name == "Blind" then "STDIO" else "Verbose " ++ name move views@(v:_) moves (Verbose p verb) = let alg = move views moves p in do name <- strategyName (fmap (\a -> Verbose (snd a) verb) alg) - liftIO $ putStrLn $ what'sUp verb name views moves + liftIO $ putStrLn $ what'sUp verb name views moves ++ "Your turn.\n" (mv,p') <- alg -- liftIO $ putStrLn $ "Move is " ++ show mv -- This is redundant because of echo back. return (mv, Verbose p' verb) @@ -370,7 +382,7 @@ recentEvents ithPlayer views moves ++ '\n' : replicate 20 '-' ++ '\n' : "Algorithm: " ++ name ++ '\n' : - prettyPV verb v ++ '\n' : "Your turn.\n" + prettyPV verb v ++ "\n" what'sUp1 verb v m = replicate 20 '-' ++ '\n' : showTrial (const "") undefined v m ++ '\n' : replicate 20 '-' ++ '\n' : @@ -403,7 +415,7 @@ data ViaHandles = VH {hin :: Handle, hout :: Handle, verbVH :: Verbosity} instance (MonadIO m) => Strategy ViaHandles m where strategyName p = return "via handles" - move views@(v:_) moves vh = liftIO $ do hPutStrLn (hout vh) $ what'sUp (verbVH vh) "via handles" views moves + move views@(v:_) moves vh = liftIO $ do hPutStrLn (hout vh) $ what'sUp (verbVH vh) "via handles" views moves ++ "Your turn.\n" mov <- repeatReadingAMoveUntilSuccess (hin vh) (hout vh) v return (mov, vh) @@ -520,7 +532,7 @@ -- | '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) +data EndGame = Failure | Soso Int | Perfect deriving (Show,Read,Eq,Generic) checkEndGame :: PublicInfo -> Maybe EndGame checkEndGame pub | lives pub == 0 = Just Failure diff --git a/hanabi-dealer.cabal b/hanabi-dealer.cabal --- a/hanabi-dealer.cabal +++ b/hanabi-dealer.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.0 +version: 0.2.1.0 -- A short (one-line) description of the package. synopsis: Hanabi card game