I was inspired by Stas Kurlin's Nim game to write my own. I'm new to Haskell, and quite unfamiliar with monads, do notation, and -- in general -- functional design patterns.In the game of nim, two players begin with a number of sized piles, e.g. piles of stones. Each player moves by taking a (non-zero) number of stones from one pile. The winning player is the one who takes the last stone (i.e. the one who makes every pile size identically zero).In my game, a NimPosition is a Map from Word64s to Word64s, where the keys are distinct pile sizes, and the values are the number of piles with that size.The user interacts with the game by entering space-separated pile sizes, which are then parsed into a list of Word64s, and these Word64s are converted to a NimPosition using the fromList function.The goal of this Map implementation is to ensure that each NimPosition has a unique representation without making the user have to think too hard about how to enter a position during play. However, I'm not too Data.Map is necessary; it makes more sense to me now to have a NimPosition be a list of Word64s, and ensure that each NimPosition is unique by having fromList be a sort function.The function nextMove (which I realize now is not a terribly descriptive name) calculates the optimal move to make from a given NimPosition. In the case that the bitwise-xor (aka nim-sum) of all the pile sizes isn't zero, then the optimal play is the (not necessarily unique) move that makes the nim-sum zero. If the nim-sum is already zero, there is no way to make it zero, so there is no optimal move.(In this case nextMove reduces the size of the largest pile by one; I don't have any good reason why, except that it probably makes it inconvenient for the human opponent, who must calculate the nim-sum to play optimally, but probably can't calculate the bitwise-xor or a list of large integers as fast as she could a list of smaller integers.)(See this)Like I said, I'm unfamiliar with Haskell and design patterns in general. But this is my first Haskell program of any length, but I guess ya gotta start somewhere.GitHubimport qualified Data.Bits as Bitimport qualified Data.Map  as Mapimport Data.Word       (Word64)import Data.List       import Data.Chardata NimPosition = NimPosition (Map.Map Word64 Word64)                 deriving (Eq)-- A NimPosition is constructed from a map from Word64 to Word64. The-- keys correspond to the distinct pile sizes, and the values-- correspond to the number of piles with that size.data Player = Human            | Computerdata GameState = Game                 { player   :: Player                 , position :: NimPosition }data Bit = Bit Bool         deriving (Eq, Ord)data Binary = Binary [Bit]            deriving (Eq, Ord)insertWithCounts :: Word64                 -> Map.Map Word64 Word64                 -> Map.Map Word64 Word64-- Insert an Word64 into a map as a key. If that Word64 is already present-- in the map as a key, then increase the value by 1. If the Word64 is-- not already present, give it the default value of 1.insertWithCounts pileSize oldMap =  Map.insertWith (\_ y -> y + 1) pileSize 1 oldMap        fromList :: [Word64] -> NimPosition-- Construct a NimPosition from a list of Word64, where each Word64 is a-- pile.fromList xs = NimPosition (foldr insertWithCounts Map.empty xs)toList :: NimPosition -> [Word64]-- Convert a NimPosition into a list of Word64, where each Word64 in the list-- corresponds to a pile.toList (NimPosition position) =     let pileSizes = Map.keys  position        pileQtys  = Map.elems position        pileLists = zipWith replicate (map fromIntegral pileQtys) pileSizes    in foldr1 (++) pileListsinstance Show NimPosition where  show = unwords . map show . toListinstance Show GameState where  show (Game Human position) = Computer's play....=>  ++ show position ++ \n                               ++ Your turn..........=>   show (Game Computer position) = toBit 0 = Bit FalsetoBit _ = Bit Trueinstance Show Bit where  show (Bit False) = 0  show (Bit True ) = 1toBitList :: Integral a => a -> [Bit]toBitList 0 = []toBitList n = let (q, r) = n `divMod` 2              in (toBit r) : toBitList qtoBinary :: Integral a => a -> BinarytoBinary n = (Binary . toBitList) ninstance Show Binary where  show (Binary bitList) = concat $ (map show) . reverse $ bitListpositionSum :: NimPosition -> Word64-- Compute the bitwise xor of the pile sizes.positionSum position = foldr1 (Bit.xor) (toList position)winning :: NimPosition -> Bool-- According to Bouton's theorem, a position in nim is winning if the-- bitwise exclusive or of the pile sizes is exactly zero.winning position = (positionSum position == 0)losing :: NimPosition -> Boollosing position = (sum . toList) position == 1terminal :: NimPosition -> Boolterminal position = (sum . toList) position == 0findNumWithLeadingBit :: [Word64] -> Maybe Word64findNumWithLeadingBit xs    | maxBinaryLengthIsUnique = lookup maxBinaryLength lengthValueAlist    | otherwise               = Nothing    where binaryExpansions        = map (show . toBinary) xs          binaryLengths           = map length binaryExpansions          lengthValueAlist        = zip binaryLengths xs          maxBinaryLength         = maximum binaryLengths          numsWithMaxBinaryLength = filter (== maxBinaryLength) binaryLengths          maxBinaryLengthIsUnique = length numsWithMaxBinaryLength == 1isValidMove :: NimPosition -> NimPosition -> BoolisValidMove prevPosition nextPosition =  let prevPiles              = toList prevPosition      nextPiles              = toList nextPosition      pilesNotInPrevPosition = nextPiles \\ prevPiles      pilesNotInNextPosition = prevPiles \\ nextPiles  in case (pilesNotInNextPosition, pilesNotInPrevPosition) of      (originalSize:[],resultantSize:[]) | resultantSize < originalSize -> True                                         | otherwise                    -> False      _ -> FalsenextMove :: NimPosition -> NimPositionnextMove prevPosition =  if winning prevPosition then    let prevList = (reverse . toList) prevPosition        nextList = (head prevList - 1) : (tail prevList)    in fromList nextList  else  let prevList = toList prevPosition  in case findNumWithLeadingBit prevList of    Just bigPile -> fromList (newPile:otherPiles)      where otherPiles = delete bigPile prevList            newPile    = foldr1 (Bit.xor) otherPiles    Nothing -> head possibleMoves      where remainingPiles   = zipWith delete prevList (repeat prevList)            remainingNimSums = map (foldr1 Bit.xor) remainingPiles            candidateLists   = zipWith (:) remainingNimSums remainingPiles            candidateMoves   = map fromList candidateLists            possibleMoves    = filter (isValidMove prevPosition) candidateMovesreadIntListFromString :: String -> [Word64]readIntListFromString input = case readIntFromString input of  (Nothing, _)              -> []  (Just intRead, remainder) -> intRead : (readIntListFromString remainder)readIntFromString :: String -> (Maybe Word64, String)readIntFromString string =  let (_, newString)         = span (isSpace) string      (intString, remainder) = span (isNumber) newString      numberRead             = case null intString of                                True  -> Nothing                                False -> Just (read intString)  in (numberRead, remainder)getIntList :: IO [Word64]getIntList = do  line <- getLine  let intListRead = readIntListFromString line in   case null intListRead of    True  -> do      putStrLn Parse error: can't read list of integers      getIntList    False -> return intListReadgetNimPosition :: IO NimPositiongetNimPosition = do  intList <- getIntList  return $ fromList intListgetValidNimPosition :: NimPosition -> IO NimPositiongetValidNimPosition oldPosition = do  newPosition <- getNimPosition  case isValidMove oldPosition newPosition of   False -> do     putStrLn Player error: not a valid position     getValidNimPosition oldPosition   True  -> return newPositiontakeTurns :: Maybe GameState -> IO (Maybe GameState)takeTurns Nothing = do putStrLn Game Over!; return NothingtakeTurns (Just currentState) =  let currentPosition = position currentState in  do (putStr . show) currentState     case (losing currentPosition) || (terminal currentPosition) of      True -> takeTurns Nothing      _ ->        case player currentState of         Computer ->           let computersNextMove = nextMove $ position currentState               nextState = currentState { player   = Human,                                       position = computersNextMove}           in takeTurns $ Just nextState         Human -> do           playersNextMove <- getValidNimPosition $ position currentState           let nextState = currentState { player   = Computer                                        , position = playersNextMove} in do             takeTurns $ Just nextStatedata YesNo = Yes | NogetYesOrNo :: IO (YesNo)getYesOrNo = do  input <- getLine  case input of   yes -> return Yes   y   -> return Yes   no  -> return No   n   -> return No   _     -> do putStr Please enter 'yes' or 'no': ; getYesOrNointroduceGame :: IO ()introduceGame = putStrLn  Welcome to Nim! To get started, enter your initial position, e.g. '1 3 5'main = do  introduceGame  putStr Initial position   =>   startingPosition <- getNimPosition  let initialGameState = Just Game { player = Computer                                   , position = startingPosition }    in takeTurns initialGameState  putStr Would you like to continue? (y/n):   shouldContinue <- getYesOrNo  case shouldContinue of   Yes -> main   No  -> do putStrLn Goodbye!; return ()
Nim game in Haskell implementing optimal strategy
beginner;game;haskell
Some ideas:For Bit and Binary use newtype rather than data to get rid of data's run-time overhead.Instead of custom Bits you could use the Data.Bits instance of Integer. This would simplify or remove a lot related code.As you noted, for NimPosition you could either use just a list, or even a multi-set.For findNumWithLeadingBit function maximumBy seems to be useful. Or perhaps even more simplified, something like (untested)where   withLengths = map (id &&& (length . show . toBinary)) xs  maxBinaryLength = maximum . map snd $ withLengths  numsWithMaxBinaryLength = filter ((== maxBinaryLength) . snd) withLengths  maxBinaryLengthIsUnique = length numsWithMaxBinaryLength == 1Rather than if it's often more readable to use guards, for example:nextMove prevPosition | winning prevPosition = ...                      | otherwise = ...Code that tries various options, to eventually find one that matches some criteria, can be often nicely expressed using the [] or Maybe monad using MonadPlus functions. Package monadplus has more useful functions, for example mfromList.It's strongly recommended to include types for all top-level functions.Otherwise nice program! I also like that you meaningfully named variables, this really helps reading the code.