diff --git a/src/Skat/AI/Base.hs b/src/Skat/AI/Base.hs index 8bdc9bb..f2a6b6d 100644 --- a/src/Skat/AI/Base.hs +++ b/src/Skat/AI/Base.hs @@ -7,6 +7,8 @@ module Skat.AI.Base where +import Data.Set (Set) +import qualified Data.Set as S import System.Random (Random) import qualified System.Random as Rand import Control.Monad.State @@ -49,14 +51,20 @@ class (MonadIO m, Show t, Show v, Show p, MonadGame t l v p m) => PlayableGame t class Choose t m | m -> t where choose :: m t -class MonadRandom m where +class Monad m => MonadRandom m where random :: Random a => m a + randomR :: Random a => (a, a) -> m a chooser :: [a] -> m a + chooser [] = error "chooser: empty list" + chooser os = (os!!) <$> randomR (0, length os - 1) + chooserS :: Set a -> m a + chooserS set + | S.null set = error "chooserS: empty set" + | otherwise = (`S.elemAt` set) <$> randomR (0, S.size set - 1) instance MonadRandom IO where random = Rand.randomIO - chooser [] = error "chooser: empty list" - chooser os = (os!!) <$> Rand.randomRIO (0, length os -1) + randomR = Rand.randomRIO instance MonadRandom (State Rand.StdGen) where random = do @@ -64,9 +72,8 @@ instance MonadRandom (State Rand.StdGen) where let (a, gen') = Rand.random gen put gen' return a - chooser [] = error "chooser: empty list" - chooser os = do + randomR bds = do gen <- get - let (a, gen') = Rand.randomR (0, length os -1) gen + let (a, gen') = Rand.randomR bds gen put gen' - return (os !! a) + return a diff --git a/src/Skat/AI/Games/Skat/Guess.hs b/src/Skat/AI/Games/Skat/Guess.hs index 78f77d1..10b8258 100644 --- a/src/Skat/AI/Games/Skat/Guess.hs +++ b/src/Skat/AI/Games/Skat/Guess.hs @@ -6,6 +6,7 @@ module Skat.AI.Games.Skat.Guess where import GHC.Generics (Generic, Generic1) import Data.Ord +import Data.Aeson import Data.Monoid ((<>)) import Data.List import Data.Set (Set) @@ -30,7 +31,7 @@ import Control.DeepSeq data Option = H Hand | Skt - deriving (Show, Eq, Ord, Generic, NFData) + deriving (Show, Eq, Ord, Generic, NFData, ToJSON) type Guess = Map Card (Set Option) @@ -69,6 +70,22 @@ hasNoLonger trump hand effCol = M.mapWithKey f S.filter (/=H hand) hands | otherwise = hands +observe :: Trump -> Maybe TurnColour -> [CardS Played] -> Guess -> Guess +observe _ Nothing _ guess = guess +observe trpCol (Just turnCol) tbl oldGuess = foldr f oldGuess tbl + where f :: CardS Played -> Guess -> Guess + f c g = let col = effectiveColour trpCol (toCard c) + in if col /= turnCol + then hasNoLonger trpCol (uorigin $ getPile c) turnCol g + else g + +observeS :: Guess -> Skat Guess +observeS guess = do + trpCol <- trump + turnCol <- gets Skat.turnColour + tbl <- getp tableCards + pure $ observe trpCol turnCol tbl guess + isSkat :: [Card] -> Guess -> Guess isSkat cs = M.mapWithKey f where f card hands @@ -96,6 +113,36 @@ choosen = choosen2 smplguess :: Guess smplguess = Hand1 `hasOnly` [(Card Seven Diamonds)..(Card Eight Hearts)] $! newGuess +smplguess2 :: Guess +smplguess2 = M.fromList + [ ( Card Seven Diamonds, S.fromList [H Hand2, H Hand3] ) + , ( Card Eight Hearts, S.fromList [H Hand2, H Hand1] ) + , ( Card Nine Spades, S.fromList [H Hand1, H Hand2] ) + , ( Card Nine Diamonds, S.fromList [Skt] ) + , ( Card Eight Diamonds, S.fromList [Skt] ) + ] + +smplguess3 :: Guess +smplguess3 = M.fromList + [ (Card Nine Clubs, S.fromList [Skt]) + , (Card Queen Clubs, S.fromList [Skt]) + , (Card Ten Hearts, S.fromList [H Hand2,H Hand3]) + , (Card Ace Diamonds, S.fromList [H Hand2]) + ] + +smplguess4 :: Guess +smplguess4 = M.fromList + [ (Card Seven Spades, S.fromList [H Hand1]) + , (Card Nine Spades, S.fromList [H Hand1]) + , (Card Eight Spades, S.fromList [H Hand2]) + , (Card Queen Diamonds, S.fromList [H Hand3]) + , (Card Ace Diamonds, S.fromList [H Hand3]) + , (Card King Clubs, S.fromList [H Hand2,H Hand3]) + , (Card Ace Clubs, S.fromList [H Hand2,H Hand3]) + , (Card Nine Clubs, S.fromList [Skt]) + , (Card Queen Clubs, S.fromList [Skt]) + ] + distributions2 :: Guess -> (Int, Int, Int, Int) -> [Distribution] distributions2 !guess1 !(n1, n2, n3, nskt) = do let h1cards = M.keys $!! M.filter (H Hand1 `elem`) guess1 @@ -142,7 +189,7 @@ randomChoice options = do g Skt = n4 > 0 opts = S.toList $ S.filter g options --when (null opts) $ error "randomChoice: after filtering options are empty" - option <- lift $ chooser opts + option <- if null opts then (error ("randomChoice: opts empty, " ++ show options ++ " " ++ show (n1,n2,n3,n4))) else lift (chooser opts) let (n1', n2', n3', n4') = case option of H Hand1 -> (n1-1, n2, n3, n4) H Hand2 -> (n1, n2-1, n3, n4) @@ -163,9 +210,73 @@ randomGuess guess (n1, n2, n3, n4) = (flip evalStateT) ( cardsPerHand + n1 let opts = M.findWithDefault (error "findWithDefault") card g o <- randomChoice opts pure $ M.insert card (S.singleton o) g - + +choosern :: (Eq a, Monad m, MonadRandom m) => Int -> [a] -> m [a] +choosern 0 _ = pure [] +choosern _ [] = error "chooseRn: list is empty and n /= 0" +choosern !n !os = do + o <- chooser os + let !os' = delete o os + rest <- choosern (n-1) os' + pure $ o : rest + +choosernS :: (Ord a, Monad m, MonadRandom m) => Int -> Set a -> m (Set a) +choosernS 0 _ = pure S.empty +choosernS !n !os + | S.size os == 0 = error "chooseRn: list is empty and n /= 0" + | otherwise = do + o <- chooserS os + let !os' = S.delete o os + rest <- choosernS (n-1) os' + pure $ S.insert o rest + + +snd3 :: (a,b,c) -> b +snd3 (a,b,c) = b + +randomDistr2 :: (MonadRandom m, Monad m) => Guess -> (Int, Int, Int, Int) -> m Distribution +randomDistr2 guess1 (n1, n2, n3, _) = do + let h1cs = M.keysSet $!! M.filter (H Hand1 `S.member`) guess1 + h2cs = M.keysSet $!! M.filter (H Hand2 `S.member`) guess1 + h3cs = M.keysSet $!! M.filter (H Hand3 `S.member`) guess1 + skcs = M.keysSet $!! M.filter (Skt `S.member`) guess1 + priority = M.filter ((==1) . S.size) guess1 + predist = M.foldrWithKey + (\card opts dist -> M.insertWith (++) (S.elemAt 0 opts) [card] dist) + M.empty + priority + banned = M.keysSet priority + pots = sortBy (comparing $ \(_, cs, n) -> length cs - n) + $ [ (H Hand1, h1cs, nh1 - length (M.findWithDefault [] (H Hand1) predist)) + , (H Hand2, h2cs, nh2 - length (M.findWithDefault [] (H Hand2) predist)) + , (H Hand3, h3cs, nh3 - length (M.findWithDefault [] (H Hand3) predist)) + , (Skt , skcs, nh4 - length (M.findWithDefault [] Skt predist)) + ] + (dist, _) <- foldM f (predist, banned) pots + + return ( M.findWithDefault (error "randomDistr: missing option Hand1") (H Hand1) dist + , M.findWithDefault (error "randomDistr: missing option Hand2") (H Hand2) dist + , M.findWithDefault (error "randomDistr: missing option Hand3") (H Hand3) dist + , M.findWithDefault (error "randomDistr: missing option Skt") Skt dist + ) + where cardsPerHand = (length guess1-2-n1-n2-n3) `div` 3 + nh1 = cardsPerHand + n1 + nh2 = cardsPerHand + n2 + nh3 = cardsPerHand + n3 + nh4 = 2 + f (dist, banned) (option, cards, n) = do + let available = S.filter (not . (`S.member` banned)) cards + cs <- if S.size available < n + then error ("Not enough options available: wanted " ++ show n ++ " for " ++ show option ++ " and got " ++ show (length available) ++ ", " ++ show guess1 ++ " with " ++ show (n1, n2, n3)) + else choosernS n available + let dist' = M.insertWith (++) option (S.toList cs) dist + pure (dist', S.union banned cs) + randomDistr :: (MonadRandom m, Monad m) => Guess -> (Int, Int, Int, Int) -> m Distribution -randomDistr guess (n1, n2, n3, n4) = (flip evalStateT) ( cardsPerHand + n1 +randomDistr = randomDistr2 + +randomDistr1 :: (MonadRandom m, Monad m) => Guess -> (Int, Int, Int, Int) -> m Distribution +randomDistr1 guess (n1, n2, n3, n4) = (flip evalStateT) ( cardsPerHand + n1 , cardsPerHand + n2 , cardsPerHand + n3 , 2 + n4 diff --git a/src/Skat/AI/MonteCarlo.hs b/src/Skat/AI/MonteCarlo.hs index f55cc04..3af42ac 100644 --- a/src/Skat/AI/MonteCarlo.hs +++ b/src/Skat/AI/MonteCarlo.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -9,9 +10,11 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DeriveGeneric #-} module Skat.AI.MonteCarlo where +import GHC.Generics import Control.Monad.State import Control.Exception (assert) import Control.Monad.Fail @@ -31,6 +34,7 @@ import System.Random (Random) import qualified System.Random as Rand import Text.Printf import Data.List.Split +import Data.Aeson hiding (Value) import Skat.AI.Base hiding (simulate) import qualified Skat as S @@ -48,6 +52,19 @@ type SimCount = Int data Tree t s = Leaf s Bool (WinCount, SimCount) | Node s Bool (WinCount, SimCount) [Tree t s] | Pending s t + deriving (Generic) + +instance (ToJSON t, ToJSON s) => ToJSON (Tree t s) where + toJSON x@Leaf{} = object [ "state" .= toJSON (treestate x) + , "valuation" .= toJSON (valuation x) + ] + toJSON x@(Node _ _ _ children) = object [ "state" .= toJSON (treestate x) + , "valuation" .= toJSON (valuation x) + , "children" .= toJSON children + ] + toJSON x@(Pending _ t) = object [ "valuation" .= ("pending" :: String) + , "turn" .= toJSON t + ] simruns :: Tree t s -> SimCount simruns (Leaf _ _ d) = snd d @@ -106,8 +123,10 @@ valuetonum v | v == tie = 0.5 -} +{- restoint :: (Player p, Value v) => p -> v -> Float restoint p v = tonum $ if maxing p then v else invert v +-} {- updateval :: (Player p, Value d) => p -> [d] -> (WinCount, SimCount) -> (WinCount, SimCount) @@ -133,12 +152,13 @@ montecarlo (Pending state turn) = do let currentTeam = current state state' = execute turn state -- objectively get a final score of random playout (independent of perspective) - values <- replicateM 100 (simulate state') - let tr = if maxing (current state) then id else invert + values <- replicateM 1000 (simulate state') + let --tr = if maxing (current state) then id else invert + tr = id vs = fmap (tonum . tr) values n = sum vs --let v = if maxing (current state') then value else invert value - let val = (n, 100) + let val = (n, 1000) pure $ Leaf state' False val montecarlo (Leaf state terminal d) | terminal || length ms == 0 = pure $ Leaf state True d @@ -152,20 +172,22 @@ montecarlo n@(Node state _ d children) in pure $ Node state True d' children | otherwise = do let myruns = snd d - cmp c = if isterminal c then -1 else selectcoeff myruns $ valuation c + cmp c + | isterminal c = -1 + | otherwise = selectcoeff (maxing $ current state) myruns $ valuation c (idx, bestChild) = maximumBy (comparing $ cmp . snd) $ zipWith (,) [0..] children updated <- montecarlo bestChild let cs = updateAt idx children updated newSimRuns = simruns updated - simruns bestChild + snd d diff = wins updated - wins bestChild - diff2 = - if newSimRuns == snd d then 0 - else - if current state == current (treestate updated) - then diff - else fromIntegral (simruns updated) - diff - newWins = diff2 + fst d + --diff2 = + -- if newSimRuns == snd d then 0 + -- else + -- if current state == current (treestate updated) + -- then diff + -- else fromIntegral (simruns updated) - diff + newWins = diff + fst d --return $ trace ("updating node " ++ show diff2 ++ "\n" ++ show updated ++ "\n" ++ show bestChild) (Node state False (newWins, newSimRuns) cs) return $ Node state False (newWins, newSimRuns) cs @@ -189,15 +211,17 @@ bestmove (Node s _ _ cs) = treestate $ selection (comparing $ rate . valuation) mxing = maxing . current $ s selection = if mxing then maximumBy else minimumBy -} -bestmove :: Tree t s -> s +bestmove :: (HasGameState t p d s, Player p) => Tree t s -> s bestmove (Leaf s _ _) = s -bestmove (Node s _ _ cs) = treestate $ maximumBy (comparing $ rate . valuation) cs +bestmove (Node s _ _ cs) = treestate $ choice (comparing $ rate . valuation) cs where rate (w, s) = w / fromIntegral s + choice = if maxing (current s) then maximumBy else minimumBy -selectcoeff :: SimCount -> (WinCount, SimCount) -> Float -selectcoeff _ (_, 0) = 10000000 -selectcoeff t (w, s) = w / fromIntegral s + explorationParam * sqrt (log (fromIntegral t) / fromIntegral s) +selectcoeff :: Bool -> SimCount -> (WinCount, SimCount) -> Float +selectcoeff _ _ (_, 0) = 10000000 +selectcoeff m t (w, s) = w' / fromIntegral s + explorationParam * sqrt (log (fromIntegral t) / fromIntegral s) where explorationParam = sqrt 2 + w' = if m then w else fromIntegral s - w reevaluate :: Tree t s -> (WinCount, SimCount) reevaluate tree @@ -218,9 +242,10 @@ reevaluateminmax tree (Node state _ _ children) -> let vals = fmap ((\(w, s) -> w / fromIntegral s) . valuation) children -- m = maxing . current $ state - childrenMaxing = all (maxing . current . treestate) children + --childrenMaxing = all (maxing . current . treestate) children selfMaxing = maxing . current $ state - newval = if childrenMaxing /= selfMaxing then 1 - maximum vals else maximum vals + choice = if selfMaxing then maximum else minimum + newval = choice vals in (newval, 1) --playCLI :: (MonadFail m, Read t, Choose t m, PlayableGame t l v p m) => m () diff --git a/src/Skat/AI/Skat.hs b/src/Skat/AI/Skat.hs index c05b3d7..71fc5f8 100644 --- a/src/Skat/AI/Skat.hs +++ b/src/Skat/AI/Skat.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} @@ -5,20 +6,26 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveGeneric #-} module Skat.AI.Skat where +import Data.String +import System.IO +import GHC.Generics import Control.Monad.State import Control.Exception (assert) import Control.Monad.Fail import Control.Monad.Writer import Data.Ord +import Data.Aeson hiding (Value) import Text.Read (readMaybe) import Data.List (maximumBy, sortBy) import Debug.Trace import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified System.Random as Rand +import qualified Data.ByteString.Lazy.Char8 as BS8 import System.IO.Unsafe @@ -61,7 +68,14 @@ data SkatState = SkatState { skatEnv :: S.SkatEnv , self :: S.Hand , guess :: Guess } - deriving Show + deriving (Show, Generic) + +instance ToJSON SkatState where + toJSON state = object [ "guess" .= toJSON (guess state) + , "table" .= toJSON (S.tableCards $ S.piles $ skatEnv state) + , "won_single" .= toJSON (S.wonCards S.Single $ S.piles $ skatEnv state) + , "won_team" .= toJSON (S.wonCards S.Team $ S.piles $ skatEnv state) + ] instance Draw SkatState where draw = show . S.tableCards . S.piles . skatEnv @@ -129,6 +143,9 @@ data Turn = Turn { turnStartingEnv :: S.SkatEnv , turnCard :: S.Card } deriving Show +instance ToJSON Turn where + toJSON turn = object [ "turn_card" .= turnCard turn ] + instance Draw Turn where draw = show . turnCard @@ -140,9 +157,17 @@ instance HasGameState Turn Bool Float SkatState where monteevaluate s = let (sgl, tm) = ev S.countGame (skatEnv s) in if sgl > tm then 1.0 else 0.0 --fromIntegral sgl / (fromIntegral $ sgl + tm) execute turn state = - let newEnv = ex (S.play_ card) env + let tbl = ev (S.getp S.tableCards) env + curhand = S.currentHand env + trpCol :: S.Trump + trpCol = ev (S.getTrump <$> gets S.skatGame) env + turnCol = ev (gets S.turnColour) env + observed = observe trpCol turnCol (card':tbl) (guess state) + guess' = card `hasBeenPlayed` observed + card' = S.CardS card (S.P curhand) + newEnv = ex (S.play_ card) env in state { skatEnv = newEnv - , guess = card `hasBeenPlayed` (guess state) + , guess = guess' } where env = turnStartingEnv turn card = turnCard turn @@ -202,10 +227,20 @@ playCLI n = do liftIO $ putStrLn "iterating" s <- get let tree = Leaf s False (0, 0) - t = runmonte n (foldM (\tree _ -> montecarlo tree) tree [1..100]) + l = length $ guess s + depth + | l >= 26 = 15 + | l >= 20 = 100 + | l >= 14 = 2000 + | otherwise = 5000 + t = runmonte n (foldM (\tree _ -> montecarlo tree) tree [1..depth]) newstate = bestmove t - --liftIO $ putStrLn $ visualise t + json :: String + json = BS8.unpack $ encode t liftIO $ print newstate + --liftIO $ withFile "tree.json" WriteMode $ \handle -> + -- hPutStrLn handle json + --liftIO $ putStrLn $ visualise t put newstate lift (put $ skatEnv newstate) else do @@ -215,7 +250,11 @@ playCLI n = do lift $ play t s <- get env <- lift get - let s' = s { skatEnv = env } + let guess' = (S.toCard t) `hasBeenPlayed` (guess s) + observed <- lift $ observeS guess' + let s' = s { skatEnv = env + , guess = observed + } put s' {- showBoard @@ -245,13 +284,13 @@ initSkatEnv n = let gen = Rand.mkStdGen n --cards = S.shuffle gen S.allCards --piles = S.distribute cards - piles = S.cardDistr3 + piles = S.cardDistr9 players = P.Players (P.PL $ S.Stupid S.Single S.Hand1) (P.PL $ S.Stupid S.Team S.Hand2) (P.PL $ S.Stupid S.Team S.Hand3) in S.SkatEnv { S.piles = piles - , S.turnColour = Nothing + , S.turnColour = Just (S.TurnColour S.Hearts) , S.skatGame = S.Colour S.Spades S.Einfach , S.players = players , S.currentHand = S.Hand1 diff --git a/src/Skat/Bidding.hs b/src/Skat/Bidding.hs index d80bab6..6274297 100644 --- a/src/Skat/Bidding.hs +++ b/src/Skat/Bidding.hs @@ -153,6 +153,7 @@ modifierFactor Ouvert = 7 allTrumps :: Game -> [Card] allTrumps (Grand _) = jacks allTrumps (Colour col _) = jacks ++ [Card t col | t <- [Ace,Ten .. Seven] ] +allTrumps _ = [] jacks :: [Card] jacks = [ Card Jack Clubs, Card Jack Spades, Card Jack Hearts, Card Jack Diamonds ] diff --git a/src/Skat/Card.hs b/src/Skat/Card.hs index 9f3c7a2..7481885 100644 --- a/src/Skat/Card.hs +++ b/src/Skat/Card.hs @@ -33,7 +33,7 @@ data Type = Seven | Ten | Ace | Jack - deriving (Eq, Ord, Show, Enum, Read, Bounded, Generic, NFData) + deriving (Eq, Ord, Show, Enum, Read, Bounded, Generic, NFData, ToJSON) data NullType = NSeven | NEight @@ -57,7 +57,7 @@ data Colour = Diamonds | Hearts | Spades | Clubs - deriving (Eq, Ord, Show, Enum, Read, Bounded, Generic, NFData) + deriving (Eq, Ord, Show, Enum, Read, Bounded, Generic, NFData, ToJSON) data Trump = TrumpColour Colour | Jacks @@ -69,7 +69,7 @@ data TurnColour = TurnColour Colour deriving (Show, Eq) data Card = Card !Type !Colour - deriving (Eq, Show, Ord, Read, Bounded, Generic) + deriving (Eq, Show, Ord, Read, Bounded, Generic, ToJSONKey) getType :: Card -> Type getType (Card t _) = t diff --git a/src/Skat/Pile.hs b/src/Skat/Pile.hs index 4e3002e..ea55ede 100644 --- a/src/Skat/Pile.hs +++ b/src/Skat/Pile.hs @@ -53,7 +53,7 @@ instance ToJSON p => ToJSON (CardS p) where object ["card" .= card, "pile" .= pile] data Hand = Hand1 | Hand2 | Hand3 - deriving (Show, Eq, Ord, Read, Enum, Bounded, Generic, NFData) + deriving (Show, Eq, Ord, Read, Enum, Bounded, Generic, NFData, ToJSON) toInt :: Hand -> Int toInt Hand1 = 1 @@ -249,10 +249,10 @@ instance Serialize String [Trick] where cardDistr :: Piles cardDistr = emptyPiles hand1 hand2 hand3 skt - where hand3 = [Card Ace Spades, Card Jack Diamonds, Card Jack Clubs, Card King Spades, + where hand1 = [Card Ace Spades, Card Jack Diamonds, Card Jack Clubs, Card King Spades, Card Nine Spades, Card Ace Diamonds, Card Queen Diamonds, Card Ten Clubs, Card Eight Clubs, Card King Clubs] - hand1 = [Card Jack Spades, Card Jack Hearts, Card Ten Spades, Card Ace Hearts, Card Ten Hearts, + hand3 = [Card Jack Spades, Card Jack Hearts, Card Ten Spades, Card Ace Hearts, Card Ten Hearts, Card Nine Hearts, Card Seven Clubs, Card Ace Clubs, Card King Diamonds, Card Ten Diamonds] hand2 = [Card Eight Spades, Card Queen Spades, Card Seven Spades, Card Seven Diamonds, @@ -302,3 +302,31 @@ cardDistr6 = emptyPiles hand1 hand2 hand3 skt Card Seven Hearts, Card Eight Hearts, Card Queen Hearts ] skt = [Card Nine Clubs, Card Queen Clubs] + +cardDistr7 :: Piles +cardDistr7 = emptyPiles hand1 hand2 hand3 skt + where hand3 = [Card Eight Spades, Card Ace Clubs] + hand1 = [Card Seven Spades, Card Nine Spades] + hand2 = [Card Ace Hearts, Card Ten Clubs] + skt = [Card Nine Clubs, Card Seven Clubs] + +cardDistr8 :: Piles +cardDistr8 = emptyPiles hand1 hand2 hand3 skt + where hand3 = [Card Ace Spades, Card Ace Clubs] + hand1 = [Card Jack Spades, Card Seven Spades] + hand2 = [Card Eight Hearts, Card King Clubs] + skt = [Card Nine Clubs, Card Seven Clubs] + +cardDistr9 :: Piles +cardDistr9 = makePiles hand1 hand2 hand3 tbl skt + where hand1 = [Card Ace Spades, Card Jack Diamonds, Card Jack Clubs, Card King Spades, + Card Nine Spades, Card Ace Diamonds, Card Queen Diamonds, Card Ten Clubs, + Card Eight Clubs] + hand3 = [Card Jack Spades, Card Jack Hearts, Card Ten Spades, Card Ten Hearts, + Card Nine Hearts, Card Seven Clubs, Card King Diamonds, + Card Ten Diamonds] + hand2 = [Card Eight Spades, Card Seven Spades, Card Seven Diamonds, + Card Seven Hearts, Card Eight Hearts, Card Queen Hearts, + Card Nine Diamonds, Card Eight Diamonds] + skt = [Card Nine Clubs, Card Queen Clubs] + tbl = [CardS (Card Ace Hearts) (P Hand3), CardS (Card King Hearts) (P Hand2)]