104 lines
2.7 KiB
Haskell
104 lines
2.7 KiB
Haskell
import Control.Monad.State
|
|
(State, evalState, replicateM, runState, state)
|
|
import System.Random (StdGen, newStdGen, randomR)
|
|
import Data.List (find, nub, sort)
|
|
|
|
combinations :: Int -> [a] -> [[a]]
|
|
combinations 0 _ = [[]]
|
|
combinations _ [] = []
|
|
combinations k (y:ys) = map (y :) (combinations (k - 1) ys) ++ combinations k ys
|
|
|
|
data Color
|
|
= Red
|
|
| Green
|
|
| Purple
|
|
deriving (Show, Enum, Bounded, Ord, Eq)
|
|
|
|
data Symbol
|
|
= Oval
|
|
| Squiggle
|
|
| Diamond
|
|
deriving (Show, Enum, Bounded, Ord, Eq)
|
|
|
|
data Count
|
|
= One
|
|
| Two
|
|
| Three
|
|
deriving (Show, Enum, Bounded, Ord, Eq)
|
|
|
|
data Shading
|
|
= Solid
|
|
| Open
|
|
| Striped
|
|
deriving (Show, Enum, Bounded, Ord, Eq)
|
|
|
|
data Card = Card
|
|
{ color :: Color
|
|
, symbol :: Symbol
|
|
, count :: Count
|
|
, shading :: Shading
|
|
} deriving (Show)
|
|
|
|
-- Identify a set of three cards by counting all attribute types.
|
|
-- if each count is 3 or 1 ( not 2 ) the the cards compose a set.
|
|
isSet :: [Card] -> Bool
|
|
isSet cs =
|
|
let total = length . nub . sort . flip map cs
|
|
in notElem 2 [total color, total symbol, total count, total shading]
|
|
|
|
-- Get a random card from a deck. Returns the card and removes it from the deck.
|
|
getCard :: State (StdGen, [Card]) Card
|
|
getCard =
|
|
state $
|
|
\(gen, cs) ->
|
|
let (i, newGen) = randomR (0, length cs - 1) gen
|
|
(a, b) = splitAt i cs
|
|
in (head b, (newGen, a ++ tail b))
|
|
|
|
-- Get a hand of cards. Starts with new deck and then removes the
|
|
-- appropriate number of cards from that deck.
|
|
getHand :: Int -> State StdGen [Card]
|
|
getHand n =
|
|
state $
|
|
\gen ->
|
|
let az = [minBound .. maxBound]
|
|
deck =
|
|
[ Card co sy ct sh
|
|
| co <- az
|
|
, sy <- az
|
|
, ct <- az
|
|
, sh <- az ]
|
|
(a, (newGen, _)) = runState (replicateM n getCard) (gen, deck)
|
|
in (a, newGen)
|
|
|
|
-- Get an unbounded number of hands of the appropriate number of cards.
|
|
getManyHands :: Int -> State StdGen [[Card]]
|
|
getManyHands n = (sequence . repeat) (getHand n)
|
|
|
|
-- Deal out hands of the appropriate size until one with the desired number
|
|
-- of sets is found. then print the hand and the sets.
|
|
showSolutions :: Int -> Int -> IO ()
|
|
showSolutions cardCount solutionCount = do
|
|
putStrLn $
|
|
"Showing hand of " ++
|
|
show cardCount ++ " cards with " ++ show solutionCount ++ " solutions."
|
|
gen <- newStdGen
|
|
let Just z =
|
|
find ((solutionCount ==) . length . filter isSet . combinations 3) $
|
|
evalState (getManyHands cardCount) gen
|
|
mapM_ print z
|
|
putStrLn ""
|
|
putStrLn "Solutions:"
|
|
mapM_ putSet $ filter isSet $ combinations 3 z
|
|
where
|
|
putSet st = do
|
|
mapM_ print st
|
|
putStrLn ""
|
|
|
|
-- Show a hand of 9 cards with 4 solutions
|
|
-- and a hand of 12 cards with 6 solutions.
|
|
main :: IO ()
|
|
main = do
|
|
showSolutions 9 4
|
|
showSolutions 12 6
|