Data commit

Task/Tic-tac-toe/Haskell/tic-tac-toe.hs

@@ -0,0 +1,220 @@
+module Main where
+
+import System.Random
+import Data.List (intercalate, find, minimumBy)
+import System.Environment (getArgs)
+import Data.Char (digitToInt)
+import Data.Maybe (listToMaybe, mapMaybe)
+import Control.Monad (guard)
+import Data.Ord (comparing)
+
+-- check if there is a horizontal, vertical or diagonal line of
+-- X or O
+tictactoe :: String -> Bool
+tictactoe a = tictactoeFor 'X' a /= tictactoeFor 'O' a
+
+-- check if there is a horizontal, vertical or diagonal line
+-- for the given player "n"
+tictactoeFor :: Char -> String -> Bool
+tictactoeFor n [a,b,c,d,e,f,g,h,i] =
+    [n,n,n] `elem` [[a,b,c],[d,e,f],[g,h,i],[a,d,g],
+                    [b,e,h],[c,f,i],[a,e,i],[c,e,g]]
+
+-- empty game board
+start :: String
+start = "         "
+
+-- check if there is an X or an O at the given position
+isPossible :: Int -> String -> Bool
+isPossible n game = (game !! n) `notElem` "XO"
+
+-- try to place an X or an O at a given position.
+-- "Right" + modified board means success, "Left" + unmodified board
+-- means failure
+place :: Int -> Char -> String -> Either String String
+place i c game =
+    if isPossible i game
+    then Right $ take i game ++ [c] ++ drop (i + 1) game
+    else Left game
+
+-- COMPUTER AI
+-- get the number of movements, starting from a given non-empty board
+-- and a position for the next movement, until the specified player
+-- wins or no movement is possible
+-- the positions are chosen sequentially, so there's not much
+-- intelligence here anyway
+developGame :: Bool -> Int -> Int -> Char -> String -> (Int, Char, String)
+developGame iterateMore moves i player game
+    | i > 8 =
+        -- if i arrives to the last position, iterate again from 0
+        -- but do it only once
+        if iterateMore
+        then developGame False moves 0 player game
+        -- draw game (after one iteration, still no winning moves)
+        else (moves, player, game)
+        -- draw game (game board full) or a win for the player
+    | moves == 9 || tictactoeFor player game = (moves, player, game)
+        -- make a move, if possible, and continue playing
+    | otherwise = case place i otherPlayer game of
+        -- position i is not empty. try with the next position
+        Left _ -> developGame iterateMore moves (i + 1)
+                    otherPlayer game
+        -- position i was empty, so it was a valid move.
+        -- change the player and make a new move, starting at pos 0
+        Right newGame -> developGame iterateMore (moves + 1) 0
+                    otherPlayer newGame
+        where
+            otherPlayer = changePlayer player
+
+-- COMPUTER AI
+-- starting from a given non-empty board, try to guess which position
+-- could lead the player to the fastest victory.
+bestMoveFor :: Char -> String -> Int
+bestMoveFor player game = bestMove
+    where
+        -- drive the game to its end for each starting position
+        continuations = [ (x, developGame True 0 x player game) |
+            x <- [0..8] ]
+        -- compare the number of moves of the game and take the
+        -- shortest one
+        move (_, (m, _, _)) = m
+        (bestMove, _) = minimumBy (comparing move) continuations
+
+-- canBlock checks if the opponent has two pieces in a row and the
+-- other cell in the row is empty, and places the player's piece there,
+-- blocking the opponent
+canBlock :: Char -> String -> Maybe Int
+canBlock p [a,b,c,d,e,f,g,h,i] =
+    listToMaybe $ mapMaybe blockable [[a,b,c],[d,e,f],[g,h,i],[a,d,g],
+                                      [b,e,h],[c,f,i],[a,e,i],[c,e,g]]
+    where
+        blockable xs = do
+          guard $ length (filter (== otherPlayer) xs) == 2
+          x <- find (`elem` "123456789") xs
+          return $ digitToInt x
+        otherPlayer = changePlayer p
+
+-- format a game board for on-screen printing
+showGame :: String -> String
+showGame [a,b,c,d,e,f,g,h,i] =
+    topBottom ++
+    "|    | 1 | 2 | 3 |\n" ++
+    topBottom ++
+    row "0" [[a],[b],[c]] ++
+    row "3" [[d],[e],[f]] ++
+    row "6" [[g],[h],[i]]
+    where
+        topBottom = "+----+---+---+---+\n"
+        row n x = "| " ++ n ++ "+ | " ++
+            intercalate " | " x ++ " |\n" ++ topBottom
+
+-- ask the user to press a numeric key and convert it to an int
+enterNumber :: IO Int
+enterNumber = do
+    c <- getChar
+    if c `elem` "123456789"
+    then do
+        putStrLn ""
+        return $ digitToInt c
+    else do
+        putStrLn "\nPlease enter a digit!"
+        enterNumber
+
+-- a human player's turn: get the number of pieces put on the board,
+-- the next piece to be put (X or O) and a game board, and return
+-- a new game state, checking if the piece can be placed on the board.
+-- if it can't, make the user try again.
+turn :: (Int, Char, String) -> IO (Int, Char, String)
+turn (count, player, game) = do
+    putStr $ "Please tell me where you want to put an " ++
+        [player] ++ ": "
+    pos <- enterNumber
+    case place (pos - 1) player game of
+        Left oldGame -> do
+            putStrLn "That place is already taken!\n"
+            turn (count, player, oldGame)
+        Right newGame ->
+            return (count + 1, changePlayer player, newGame)
+
+-- alternate between X and O players
+changePlayer :: Char -> Char
+changePlayer 'O' = 'X'
+changePlayer 'X' = 'O'
+
+-- COMPUTER AI
+-- make an automatic turn, placing an X or an O game board.
+-- the first movement is always random.
+-- first, the computer looks for two pieces of his opponent in a row
+-- and tries to block.
+-- otherwise, it tries to guess the best position for the next movement.
+-- as a last resort, it places a piece randomly.
+autoTurn :: Bool -> (Int, Char, String) -> IO (Int, Char, String)
+autoTurn forceRandom (count, player, game) = do
+    -- try a random position 'cause everything else failed
+    -- count == 0 overrides the value of forceRandom
+    i <- if count == 0 || forceRandom
+            then randomRIO (0,8)
+            else return $
+                case canBlock player game of
+                    -- opponent can't be blocked. try to guess
+                    -- the best movement
+                    Nothing -> bestMoveFor player game
+                    -- opponent can be blocked, so just do it!
+                    Just blockPos -> blockPos
+    -- if trying to place a piece at a calculated position doesn't work,
+    -- just try again with a random value
+    case place i player game of
+        Left oldGame -> autoTurn True (count, player, oldGame)
+        Right newGame -> do
+            putStrLn $ "It's player " ++ [player] ++ "'s turn."
+            return (count + 1, changePlayer player, newGame)
+
+-- play a game until someone wins or the board becomes full.
+-- depending on the value of the variable "auto", ask the user(s) to
+-- put some pieces on the board or do it automatically
+play :: Int -> (Int, Char, String) -> IO ()
+play auto cpg@(_, player, game) = do
+    newcpg@(newCount, newPlayer, newGame) <- case auto of
+        -- if both players are human, always ask them
+        0 -> turn cpg
+        -- if both players are computer, always play auto
+        1 -> autoTurn False cpg
+        -- X is computer, O is human
+        2 -> if player == 'X' then autoTurn False cpg else turn cpg
+        -- X is human, O is computer
+        3 -> if player == 'O' then autoTurn False cpg else turn cpg
+    putStrLn $ "\n" ++ showGame newGame
+    if tictactoe newGame
+    then putStrLn $ "Player " ++ [changePlayer newPlayer] ++ " wins!\n"
+    else
+        if newCount == 9
+        then putStrLn "Draw!\n"
+        else play auto newcpg
+
+-- main program: greet the user, ask for a game type, ask for the
+-- player that'll start the game, and play the game beginning with an
+-- empty board
+main :: IO ()
+main = do
+    a <- getArgs
+    if null a
+    then usage
+    else do
+        let option = head a
+        if option `elem` ["0","1","2","3"]
+        then do
+            putStrLn $ "\n" ++ showGame start
+            let m = read option :: Int
+            play m (0, 'X', start)
+        else usage
+
+usage :: IO ()
+usage = do
+    putStrLn "TIC-TAC-TOE GAME\n================\n"
+    putStrLn "How do you want to play?"
+    putStrLn "Run the program with one of the following options."
+    putStrLn "0 : both players are human"
+    putStrLn "1 : both players are computer"
+    putStrLn "2 : player X is computer and player O is human"
+    putStrLn "3 : player X is human and player O is computer"
+    putStrLn "Player X always begins."