From 2c53f1e1fb951af8b5460cca0c458e40c2742445 Mon Sep 17 00:00:00 2001 From: TANIGUCHI Kohei Date: Thu, 18 Jun 2015 03:28:12 +0900 Subject: [PATCH] initial commit --- .gitignore | 15 ++++++++++++ Board.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++ LICENSE | 20 ++++++++++++++++ Main.hs | 40 +++++++++++++++++++++++++++++++ Player.hs | 30 +++++++++++++++++++++++ Setup.hs | 2 ++ ttt.cabal | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 243 insertions(+) create mode 100644 .gitignore create mode 100644 Board.hs create mode 100644 LICENSE create mode 100644 Main.hs create mode 100644 Player.hs create mode 100644 Setup.hs create mode 100644 ttt.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..48fe6f3 --- /dev/null +++ b/.gitignore @@ -0,0 +1,15 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp diff --git a/Board.hs b/Board.hs new file mode 100644 index 0000000..95aa3bc --- /dev/null +++ b/Board.hs @@ -0,0 +1,66 @@ +module Board + ( Board + , Piece(..) + , Position + , isWon + , emptyBoard + , showBoard + , updateBoard + , canPlace + , change + , isFull + ) where + +import Data.Maybe (isJust) +import Data.List (intercalate, intersperse, transpose) +import Data.List.Split (chunksOf) + +data Piece = X | O deriving (Eq, Show, Ord) + +change :: Piece -> Piece +change X = O +change O = X + +{- + 1 | 2 | 3 +---+---+--- + 4 | 5 | 6 +---+---+--- + 7 | 8 | 9 +-} +type Position = Int +type Board = [Maybe Piece] + +showBoard :: Board -> String +showBoard = + unlines . + intersperse "---+---+---" . + map (intercalate "|") . + chunksOf 3 . + map (\p -> " " ++ maybe " " show p ++ " ") + +emptyBoard :: Board +emptyBoard = replicate 9 Nothing + +sampleBoard :: Board +sampleBoard = take 9 $ cycle [Nothing, Just X, Just O, Nothing] + +isFull :: Board -> Bool +isFull = all isJust + +isWon :: Board -> Bool +isWon b = any full $ rows ++ cols ++ diagonals + where + full ps@[p1,p2,p3] = all isJust ps && p1 == p2 && p2 == p3 + rows = chunksOf 3 b + cols = transpose rows + diagonals = map (map (b !!)) [[0,4,8], [2,4,6]] + +isFinished :: Board -> Bool +isFinished board = isFull board || isWon board + +updateBoard :: Position -> Piece -> Board -> Board +updateBoard position piece board = take (position - 1) board ++ [Just piece] ++ drop position board + +canPlace :: Position -> Board -> Bool +canPlace position board = not $ isJust $ board !! (position - 1) diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..7832468 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 TANIGUCHI Kohei + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..532e56e --- /dev/null +++ b/Main.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +module Main where + +import Control.Monad.Random +import Control.Monad.State + +import Board +import Player + +main :: IO () +main = evalStateT (game human ai) initialGameState + where + -- ai = serialAI + ai = randomAI + -- ai = human + + +data GameState = GameState { board :: Board, active :: Piece } + +initialGameState :: GameState +initialGameState = GameState emptyBoard X + +-- type Winner = Piece +-- game :: (MonadState GameState m) => Player m -> Player m -> m Winner +-- game :: (MonadState GameState m, MonadWriter [Board] m) => Player m -> Player m -> m Winner +game :: (MonadState GameState m) => Player m -> Player m -> m () +game p1 p2 = do + board <- gets board + pos <- p1 board + if not $ canPlace pos board + then game p1 p2 + else do + piece <- gets active + let board' = updateBoard pos piece board + modify $ \s -> GameState { board = board', active = change piece } + if isFull board' || isWon board' + then return () + else game p2 p1 diff --git a/Player.hs b/Player.hs new file mode 100644 index 0000000..384063b --- /dev/null +++ b/Player.hs @@ -0,0 +1,30 @@ +module Player where + +import Control.Monad.Random +import Control.Monad.State +import System.IO (hFlush, stdout) + +import Board + +type Player m = Board -> m Position +-- type Player m = Piece -> Board -> m Position -- know which turn + +human :: MonadIO m => Player m +human board = liftIO $ do + putStr $ showBoard board + putStr "Input hand: " + hFlush stdout -- force `putStr` before `readLn` + readLn + +randomAI :: MonadRandom m => Player m +randomAI _board = getRandomR (1,9) + +serialAI :: Monad m => Player m +serialAI board = evalStateT serialAI' (cycle [1..9]) + where + serialAI' = do + i:is <- get + put is + if canPlace i board + then return i + else serialAI' diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ttt.cabal b/ttt.cabal new file mode 100644 index 0000000..34b4c48 --- /dev/null +++ b/ttt.cabal @@ -0,0 +1,70 @@ +-- The name of the package. +name: ttt + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Tic Tac Toe AI + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: TANIGUCHI Kohei + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: a.d.xvii.kal.mai@gmail.com + +-- A copyright notice. +-- copyright: + +category: Game + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +-- extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +executable ttt + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + other-modules: + Board + , Player + + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: MonadRandom >= 0.3.0.2 + , base >=4.8 && <4.9 + , monad-skeleton >= 0.1.1 + , mtl >= 2.2.1 + , split >= 0.2.2 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010