hanabi-dealer 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+83/−38 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- ChangeLog.md +6/−0
- Game/Hanabi.hs +75/−36
- hanabi-dealer.cabal +2/−2
ChangeLog.md view
@@ -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.
Game/Hanabi.hs view
@@ -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<n<10} starts selfplay with youselves:D+-- Also,+--+-- > selfplay defaultGS{numPlayers=n}+--+-- (where 1<n<10) starts selfplay with youselves:D selfplay gs = do g <- newStdGen ((finalSituation,_),_) <- start gs [stdio] g@@ -230,7 +269,7 @@ len2 =len `div` 2 in reverse (drop len2 ys) ++ xs ++ drop (len - len2) ys --- | 'start' creates and runs a game. This is just the composition of createGame and run.+-- | 'start' creates and runs a game. This is just the composition of 'createGame' and 'run'. start :: (RandomGen g, Monad m, Strategies ps m) => 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
hanabi-dealer.cabal view
@@ -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: