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.0.0 -- 2019-12-20 + +* define the Verbosity option + +* confirm running with base-4.13 compiled by GHC-8.8.1. + ## 0.1.0.0 -- 2019-12-18 * First version. Released on an unsuspecting world. diff --git a/Game/Hanabi.hs b/Game/Hanabi.hs --- a/Game/Hanabi.hs +++ b/Game/Hanabi.hs @@ -5,14 +5,17 @@ prettyEndGame, isMoveValid, checkEndGame, help, -- * Datatypes -- ** The Class of Strategies - Strategies, Strategy(..), Verbose(..), STDIO, Blind, ViaHandles(..), + Strategies, Strategy(..), Verbose(..), STDIO, Blind, ViaHandles(..), Verbosity(..), verbose, -- ** The Game Specification GameSpec(..), defaultGS, Rule(..), defaultRule, -- ** The Game State and Interaction History Move(..), Index, State(..), PrivateView(..), PublicInfo(..), EndGame(..), -- ** The Cards Card(..), Color(..), Number(..), cardToInt, intToCard, readsColorChar, readsNumberChar, - -- * Other Utilities + -- * Utilities + -- ** Hints + isCritical, isUseless, bestPossibleRank, + -- ** Minor ones what'sUp, what'sUp1, ithPlayer) where -- module Hanabi where import qualified Data.IntMap as IM @@ -94,7 +97,7 @@ , funPlayerHand :: [Int] -- ^ memoized function taking the number of players; the default is [5,5,4,4]++repeat 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 normal and Variant 1 (and Variant 3?), and @[1,1,1,1,1]@ for Variant 2. + , 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) @@ -147,6 +150,29 @@ , result :: Result -- ^ The result of the last move. This info may be separated from 'PublicInfo' in future. } deriving (Read, Show) + + + +-- | the best achievable rank for each color. +bestPossibleRank :: PublicInfo -> Color -> Number +bestPossibleRank pub iro = toEnum $ length $ dropWhile (==0) $ zipWith subtract (reverse $ numCards (gameSpec pub) iro) + (map ((discarded pub IM.!) . cardToInt . C iro) [K5, K4 .. K1]) +numCards :: GameSpec -> Color -> [Int] +numCards gs iro = if iro==Multicolor then numMulticolors $ rule gs else [3,2,2,2,1] +-- | isUseless pi card means either the card is already played or it is above the bestPossibleRank. +isUseless :: PublicInfo -> Card -> Bool +isUseless pub card = number card <= (played pub IM.! fromEnum (color card)) -- the card is already played + || number card > bestPossibleRank pub (color card) +-- | A critical card is a useful card and the last card that has not been dropped. +-- +-- Unmarked critical card on the chop should be marked. +isCritical :: PublicInfo -> Card -> Bool +isCritical pub card = not (isUseless pub card) + && succ (discarded pub IM.! cardToInt card) == (numCards (gameSpec pub) (color card) !! (pred $ fromEnum $ number 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) @@ -155,8 +181,7 @@ -- I guess, sometimes, ignorance of other players might also be an important knowledge. -- Algorithms that want updated info could implement the functionality for themselves. --- 特にStateのHistoryについて語る場合、捨てたりplayすることでカードの内容が明らかになり、「そのカードについてそういうヒントを出したからには」みたいな推論ができるようになる。ので、単にStateを積み重ねていくのではなく、どんどん更新していくべきか？でも、「こいつは知らないはずだからこういうヒントを出した」みたいなこともありえるわけで、更新すればいいってものでもない。まあ、そういうのがよく出てくるのはmulticolorの場合だが。 --- てか、Historyのupdateを行う関数をcomponent libraryにいれとけばよいだけ。 + -- | PrivateView is the info that is available to the player that has @head 'hands'@. data PrivateView = PV { publicView :: PublicInfo , handsPV :: [[Card]] -- ^ Other players' hands. [next player's hand, second next player's hand, ...] @@ -165,25 +190,38 @@ , 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) -prettyPV pv@PV{publicView=pub} = prettyPI pub ++ "\nMy hand:\n" +prettyPV :: Verbosity -> PrivateView -> String +prettyPV v pv@PV{publicView=pub} = prettyPI pub ++ "\nMy hand:\n" ++ concat (replicate (length myHand) " __") ++ "\n" - ++ concat (replicate (length myHand) "|**") ++ "|\n|" - ++ showHintLine myHand ++ "\n" + ++ concat (replicate (length myHand) "|**") ++ "|\n" + ++ (if markHints v then showHintLine myHand else "") -- x ++ concat (replicate (length myHand) " ~~") ++ "\n" ++ concat [ '+':shows d "-" | d <- [0 .. pred $ length myHand] ] - ++ concat (zipWith3 (prettyHand ithPlayer $ numPlayers $ gameSpec $ pub) [1..] (handsPV pv) $ tail $ givenHints pub) + ++ 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 ithP $ numPlayers $ gameSpec $ pub) [0..] (hands st) $ givenHints pub) -prettyHand :: (Int->Int->String) -> Int -> Int -> [Card] -> [(Maybe Color, Maybe Number)] -> String -prettyHand ithP numP i cards hl = "\n\n" ++ ithP numP i ++ " hand:\n" - ++ concat (replicate (length cards) " __") ++ " \n" - ++ concat [ '|':show card | card <- cards ] ++"|\n|" - ++ showHintLine hl ++ "\n" +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} +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 " __" + | (card, tup) <- zip cards hl ] ++"\n" + ++ concat [ '|':show card | card <- cards ] ++"|\n" + ++ (if markHints v then showHintLine hl else "") ++ concat (replicate (length cards) "+--") showHintLine :: [(Maybe Color, Maybe Number)] -> String -showHintLine hl = concat [ maybe ' ' (head . show) mc : maybe ' ' (head . show . fromEnum) mk : "|" | (mc,mk) <- hl] +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 "!!" + , markUseless :: Bool -- ^ mark useless cards with ".." + , markHints :: Bool -- ^ mark hints + } deriving (Read, Show) + + prettyPI pub {- This was too verbose = let @@ -205,14 +243,15 @@ handsPV = tail $ hands st, invisibleBag = foldr (IM.update (Just . pred)) (nonPublic $ publicState st) $ map cardToInt $ concat $ tail $ hands st} --- 自分のturnが来た時のstateのhistoryだけでは不十分で、他の各playerのturnでのStateがわからないと、そのplayerがどういうMoveを選んだのかわからない。 --- てか、Stateだけでなく必ずMoveの情報は必要。Hint moveの場合、Stateは変化しない。変化するようにHintをメモったものをStateにするにしても、すでにわかっているものを敢えてHintし直す、というconventionをやったときにどういうHintかわからない（ので、Hatみたいな感じで意味をもたせられない） --- まあ、Hanabi Learning Environmentがそのへんをちゃんと考えているかしらないが、でもまあHatを実装しているはずなので大丈夫だろう。 main = selfplay defaultGS -- | 'selfplay' starts selfplay with yourself:) -- --- Also, @selfplay defaultGS{numPlayers=n}@ (where 1 selfplay defaultGS{numPlayers=n} +-- +-- (where 1 GameSpec -> ps -> g -> m (((EndGame, [State], [Move]), ps), g) start gs players gen = let @@ -241,7 +280,7 @@ case mbeg of Nothing -> run sts mvs ps Just eg -> return ((eg, sts, mvs), ps) --- | The Strategy class is exactly the interface that +-- | The 'Strategy' class is exactly the interface that -- AI researchers defining their algorithms have to care about. class Monad m => Strategy p m where -- | 'strategyName' is just the name of the strategy. The designer of the instance should choose one. @@ -314,28 +353,28 @@ in return ((checkEndGame $ publicState nxt, nxt:states, mov:moves), p') -- | Verbose makes a player verbose. It is useful to monitor the viewpoint of a specific player. -newtype Verbose p = Verbose {unV :: p} deriving (Read, Show) +data Verbose p = Verbose {unV :: p, verbV :: Verbosity} deriving (Read, Show) instance (Strategy p m, MonadIO m) => Strategy (Verbose p) m where strategyName mp = do name <- strategyName $ fmap unV mp return $ if name == "Blind" then "STDIO" else "Verbose " ++ name - move views@(v:_) moves (Verbose p) = let alg = move views moves p in - do name <- strategyName (fmap (Verbose . snd) alg) - liftIO $ putStrLn $ what'sUp name views moves + 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 (mv,p') <- alg -- liftIO $ putStrLn $ "Move is " ++ show mv -- This is redundant because of echo back. - return (mv, Verbose p') + return (mv, Verbose p' verb) observe _ [] _ = return () - observe (v:_) (m:_) _ = liftIO $ putStrLn $ what'sUp1 v m + observe (v:_) (m:_) (Verbose _ verb) = liftIO $ putStrLn $ what'sUp1 verb v m -what'sUp name views@(v:_) moves = replicate 20 '-' ++ '\n' : +what'sUp verb name views@(v:_) moves = replicate 20 '-' ++ '\n' : recentEvents ithPlayer views moves ++ '\n' : replicate 20 '-' ++ '\n' : "Algorithm: " ++ name ++ '\n' : - prettyPV v ++ '\n' : "Your turn.\n" -what'sUp1 v m = replicate 20 '-' ++ '\n' : + prettyPV verb v ++ '\n' : "Your turn.\n" +what'sUp1 verb v m = replicate 20 '-' ++ '\n' : showTrial (const "") undefined v m ++ '\n' : replicate 20 '-' ++ '\n' : - prettyPV v + prettyPV verb v recentEvents ithP vs@(v:_) ms = unlines $ reverse $ zipWith3 (showTrial $ ithP nump) [pred nump, nump-2..0] vs ms where nump = numPlayers $ gameSpec $ publicView v @@ -355,16 +394,16 @@ ithPlayerFromTheLast nump j = "The " ++ ith (nump-j) ++"last player's" type STDIO = Verbose Blind -stdio = Verbose Blind +stdio = Verbose Blind verbose data Blind = Blind instance (MonadIO m) => Strategy Blind m where strategyName p = return "Blind" move (v:_) _ _ = do mov <- liftIO $ repeatReadingAMoveUntilSuccess stdin stdout v return (mov, Blind) -data ViaHandles = VH {hin :: Handle, hout :: Handle} +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 "via handles" views moves + move views@(v:_) moves vh = liftIO $ do hPutStrLn (hout vh) $ what'sUp (verbVH vh) "via handles" views moves mov <- repeatReadingAMoveUntilSuccess (hin vh) (hout vh) v return (mov, vh) @@ -480,7 +519,7 @@ where rotateList xs = case splitAt (num `mod` numPlayers gS) xs of (tk,dr) -> dr++tk -- | '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'. +-- 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) checkEndGame :: PublicInfo -> Maybe EndGame 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.1.0.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Hanabi card game @@ -65,7 +65,7 @@ -- , CPP, TupleSections, NoOverlappingInstances -- Other library packages from which modules are imported. - build-depends: base >=4.8 && <4.12, containers >=0.5, random >=1.1 + build-depends: base >=4.8 && <4.14, containers >=0.5, random >=1.1 -- Directories containing source files. -- hs-source-dirs: