Set puzzle: Difference between revisions
→{{header|Haskell}}: Specified imports, tidied isSet and getHand, applied hlint hindent
(→{{header|Haskell}}: Specified imports, tidied isSet and getHand, applied hlint hindent) |
|||
Line 1,750:
=={{header|Haskell}}==
<lang haskell>import
(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
data Color = Red | Green | Purple deriving (Show, Enum, Bounded, Ord, Eq)▼
= Red
data Symbol = Oval | Squiggle | Diamond deriving (Show, Enum, Bounded, Ord, Eq)▼
| Green
data Count = One | Two | Three deriving (Show, Enum, Bounded, Ord, Eq)▼
| Purple
data Shading = Solid | Open | Striped deriving (Show, Enum, Bounded, Ord, Eq)▼
data
= Oval
color :: Color,▼
| Squiggle
symbol :: Symbol,▼
| Diamond
count :: Count,▼
shading :: Shading▼
} deriving (Show)▼
data Count
-- Identify a set of three cards by counting all attribute types. ▼
= One
| Two
| Three
data Shading
= Solid
| Open
| Striped
data Card = Card
-- if each count is 3 or 1 ( not 2 ) the the cards compose a set.
isSet :: [Card] -> Bool
isSet 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 =
getCard = state $ \(gen, cs) -> let (i, newGen) = randomR (0, length cs - 1) gen ▼
state $
(a,b) = splitAt i cs▼
\(gen, 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 $
let deck = [Card co sy ct sh | ▼
\gen ->
let az
deck
[ Card co sy
(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
Line 1,807 ⟶ 1,831:
showSolutions :: Int -> Int -> IO ()
showSolutions cardCount solutionCount = do
putStrLn $ "Showing hand of " ++ show cardCount ++ " cards with " ++ show solutionCount ++ " solutions."▼
"Showing hand of
▲
let Just z = find (\ls -> length (filter isSet $ combinations 3 ls) == solutionCount) $ ▼
gen <- newStdGen
evalState (getManyHands cardCount) gen▼
let Just z =
mapM_ print z▼
▲
▲ putStrLn ""
putStrLn "Solutions:"▼
mapM_ print z
mapM_ putSet $ filter isSet $ combinations 3 z where▼
▲ putSet st = do
▲ mapM_ print st
▲ putStrLn ""
where
putSet st = do
putStrLn ""
-- Show a hand of 9 cards with 4 solutions
-- and a hand of 12 cards with 6 solutions.
main :: IO ()
main = do
{{out}}
<pre style="font-size:80%">Showing hand of 9 cards with 4 solutions.
| |||