Add a Nim bot

unilectures.hs/Nim/Base.hs

@@ -0,0 +1,20 @@
+module Base where
+
+data Player = CliPlayer String | Idiot | CpuPlayer deriving Show
+
+type Heap = Int
+
+type Heaps = [Heap]
+
+data Game = Game { heaps :: Heaps, players :: [Player] }
+
+player :: Game -> Player
+player = head . players
+
+nextPlayer :: Game -> Game
+nextPlayer g = g { players = rotate $ players g } where
+  rotate (x:xs) = xs ++ [x]
+
+type Move = ( Int -- ^ heap from which to take the pieces
+            , Int -- ^ amount of pieces to take away
+            )

unilectures.hs/Nim/CpuPlayer.hs

@@ -0,0 +1,15 @@
+module CpuPlayer (runCpuPlayer) where
+
+import Data.Bits (xor)
+import Data.List (findIndices)
+import Base
+
+-- | A list of pissbilbe winning moves in a game of Nim
+--
+-- >>> runCpuPlayer [3,4,5]
+-- [(1,2)]
+runCpuPlayer :: Heaps -> [Move]
+runCpuPlayer hs = filter ((>0) . snd) $ zip [1..] $ map aux hs
+  where
+    aux h = h - (h `xor` s)
+    s  = foldr1 xor hs

unilectures.hs/Nim/Nim.hs

@@ -1,29 +1,29 @@
 module Nim where
 
 import Control.Monad
-import Control.Monad.Except
+import System.Random (randomRIO)
 
 import Utils
+import Base
+import CpuPlayer
 
-data Player = Player1 | Player2 deriving Show
+randomPickIO :: [a] -> IO a
+randomPickIO xs = fmap (xs !!) $ randomRIO (0, pred $ length xs)
 
-otherPlyer :: Player -> Player
-otherPlyer Player1 = Player2
-otherPlyer Player2 = Player1
+newGame :: [Player] -> Game
+newGame ps = Game { heaps = [1,3,5,7], players = ps }
 
-data Game = Game { heaps :: [Int], player :: Player }
+showHeaps :: Heaps -> String
+showHeaps hs = concatMap aux $ zip [1..] $ hs where
+    aux (i,h) = show i ++ " " ++ padTo ' ' m (replicate h '|') ++ "\n"
+    m = maximum hs
 
-newGame :: Game
-newGame = Game { heaps = [1,3,5,7], player = Player1 }
+possibleMoves :: Heaps -> [Move]
+possibleMoves hs = concatMap aux $ zip [1..] hs where
+  aux (i,h) = [(i,a) | a <- [1..h] ]
 
-instance Show Game where
-  show g = concatMap aux (zip [1..] $ heaps g) ++ show (player g) where
-    aux (i,a) = show i ++ " " ++ padTo ' ' m (replicate a '|') ++ "\n"
-    m = maximum $ heaps g
-
-move :: Int -> Int -> Game -> Either String Game
-move h a g = do
-  let hs = heaps g
+runMove :: Move -> Heaps -> Either String Heaps
+runMove (h,a) hs = do
   when (h > length hs)
     $ Left "Heap number too high"
   when (h <= 0)
@@ -32,23 +32,42 @@ move h a g = do
     $ Left "Must take at least one piece"
   when (a > (hs !! pred h))
     $ Left $ "Can only take " ++ show (hs !! h) ++ " pieces"
-  return g { heaps = filter (/=0) $ adjust (subtract a) (pred h) hs }
+  return $ filter (/=0) $ adjust (subtract a) (pred h) hs
 
-nim :: Game -> IO()
-nim g = do
-  putStr "\n" >> print g
+runPlayer :: Player -> Heaps -> IO Move
+runPlayer (CliPlayer name) hs = do
+  putStrLn name
   h <- readLnWith " enter a heap: "
   a <- readLnWith " and enter an amount: "
-  let eg = move h a g
-  case eg of (Left e)   -> print e >> nim g
-             (Right g') -> winCheck g'
+  return (h,a)
+runPlayer Idiot            hs = do
+  putStrLn "Idiot player takes away first piece..."
+  return (1,1)
+runPlayer CpuPlayer        hs = do
+  putStrLn "CPU player takes their move..."
+  let opts = runCpuPlayer $ hs
+  randomPickIO $ if null opts then possibleMoves hs else opts
+
+nim :: Game -> IO()
+nim g = do
+  putStr "\n"
+  putStr $ showHeaps $ heaps g
+  m <- runPlayer (player g) (heaps g)
+  let eg = runMove m (heaps g)
+  case eg of (Left  e ) -> print e >> nim g
+             (Right hs) -> if null hs
+               then winning (player g)
+               else nextTurn g { heaps = hs }
   where
-    winCheck g   = if null (heaps g) then winning (player g) else nextTurn g
-    winning p    = putStr $ "\n  +++ Congratulations, you won " ++ show p ++ "! +++\n"
-    nextTurn g   = nim $ g { player = otherPlyer (player g) }
-    readLnWith s = putStr s >> (readLn `catchError` const (readLnWith s))
+    nextTurn = nim . nextPlayer
+
+winning :: Player -> IO()
+winning (CliPlayer name) = putStr $ "\n  +++ Congratulations, you won " ++ name ++ "! +++\n"
+winning Idiot            = putStr   "\n  +++ Wow, you lost. +++\n"
+winning CpuPlayer        = putStr   "\n  +++ Game over! +++\n"
 
 main :: IO()
 main = do
   putStrLn "\n  +++ Welcome to NIM +++"
-  nim newGame
+  putStrLn " (try to take the last piece)"
+  nim $ newGame [CpuPlayer, CliPlayer "Bernhard"]

unilectures.hs/Nim/Utils.hs

@@ -1,4 +1,6 @@
-module Utils where
+module Utils (adjust, padTo, readLnWith) where
+
+import Control.Monad.Except (catchError)
 
 -- | Update a value at a specific index with the result of the provided function.
 --   When the indext is out of bounds, the original list is returned.
@@ -35,3 +37,7 @@ padTo with to xs = replicate a with ++ xs ++ replicate b with where
   l = length xs
   a = (to-l) `div` 2
   b = to - l - a
+
+-- | Ask repeatadly for user input until read succeeds.
+readLnWith :: Read a => String -> IO a
+readLnWith s = putStr s >> (readLn `catchError` const (readLnWith s))