From ada4ffd3567f585931cf9dc41985fa59eac8f22c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bernhard=20H=C3=A4ussner?= Date: Thu, 25 Feb 2016 01:39:44 +0100 Subject: [PATCH] Add a Nim bot --- unilectures.hs/Nim/Base.hs | 20 +++++++++ unilectures.hs/Nim/CpuPlayer.hs | 15 +++++++ unilectures.hs/Nim/Nim.hs | 75 +++++++++++++++++++++------------ unilectures.hs/Nim/Utils.hs | 8 +++- 4 files changed, 89 insertions(+), 29 deletions(-) create mode 100644 unilectures.hs/Nim/Base.hs create mode 100644 unilectures.hs/Nim/CpuPlayer.hs diff --git a/unilectures.hs/Nim/Base.hs b/unilectures.hs/Nim/Base.hs new file mode 100644 index 0000000..1465a9c --- /dev/null +++ b/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 + ) diff --git a/unilectures.hs/Nim/CpuPlayer.hs b/unilectures.hs/Nim/CpuPlayer.hs new file mode 100644 index 0000000..309ac9f --- /dev/null +++ b/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 diff --git a/unilectures.hs/Nim/Nim.hs b/unilectures.hs/Nim/Nim.hs index 917b86d..473b9ee 100644 --- a/unilectures.hs/Nim/Nim.hs +++ b/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"] diff --git a/unilectures.hs/Nim/Utils.hs b/unilectures.hs/Nim/Utils.hs index a71d2ee..36c7503 100644 --- a/unilectures.hs/Nim/Utils.hs +++ b/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))