|
|
|
|
|
||
|
||
ルールが簡単な分、簡単にできました。
しかも、人VSコンピュータもできます。結構賢いですよ。
以下のようにすると、人VS人もできます。
main = playGame playerMan playerMan
-------------------------------------------------------------------------------
-- ○×ゲーム（三目並べ）
-- ○×ゲームは先手必勝でも後手必勝でもなく、両者が最善の手を打つと引き分けます。
-------------------------------------------------------------------------------
import System.Random
data Piece = Empty | O | X deriving (Eq, Show)
type Board = [[Piece]]
type Pt = (Int,Int)
boardSize::Int
boardSize = 3 -- ３固定
-------------------------------------------------------------------------------
-- 盤面の初期化
-------------------------------------------------------------------------------
initBoard:: Board
initBoard = [[ Empty | x <- [0,1,2]] | y <- [0,1,2]]
-------------------------------------------------------------------------------
-- 盤面の指定された場所のコマを返す。
-------------------------------------------------------------------------------
getBoard:: Board -> Pt -> Piece
getBoard board (x,y) = board !! y !! x
-------------------------------------------------------------------------------
-- 盤面の指定された場所にコマを置いて、新しい盤面を返す。
-------------------------------------------------------------------------------
setBoard:: Board -> Pt -> Piece -> Board
setBoard board (x,y) val = bs1 ++ [ps1 ++ [val] ++ ps2] ++ bs2 where
(bs1,b:bs2) = splitAt y board
(ps1,_:ps2) = splitAt x b
-------------------------------------------------------------------------------
-- 盤面の内容を表示する
-------------------------------------------------------------------------------
showBoard:: Board -> IO ()
showBoard board = putStr (concat (map showLine board))
where
showLine line = unwords (map getSymbol line) ++ "\n"
getSymbol val = case val of
Empty -> "- "
O -> "O "
X -> "X "
-------------------------------------------------------------------------------
-- 相手の色
-------------------------------------------------------------------------------
opponent:: Piece -> Piece
opponent ox = if ox==O then X else O
-------------------------------------------------------------------------------
-- 盤面上の白黒いずれかの個数を返す．
-------------------------------------------------------------------------------
getCount:: Board -> Piece -> Int
getCount board ox =
length (filter (\val -> val == ox) (concat board))
-------------------------------------------------------------------------------
-- 盤面の外か？
-------------------------------------------------------------------------------
outOfBounds (x,y) =
x < 0 || x > 2 || y < 0 || y > 2
-------------------------------------------------------------------------------
-- 石を置く
-- oxの手番で，pointに石を置く．
-- 手が有効であれば，石を置く処理を行ってTrueと盤面を返す．
-- そうでなければ，Falseと盤面を返す．
-------------------------------------------------------------------------------
doMove:: Piece -> Pt -> Board -> (Bool,Board)
doMove ox pt board =
if getBoard board pt == Empty
then (True, setBoard board pt ox)
else (False, board)
-------------------------------------------------------------------------------
-- MANプレイヤ操作関数
-- 手を入力して 局面を進めて，Trueと盤面を返す．
-- -1,-1を入力した場合，投了であるとして，Falseと盤面を返す．
-------------------------------------------------------------------------------
playerMan:: Piece -> Board -> IO (Bool,Board)
playerMan ox board = do
-- プロンプト
putStrLn (show ox ++ ">> ")
-- 手を読み込む
x <- getLine >>= return . read
y <- getLine >>= return . read
if x == -1
then return (False, board) -- Falseを返して終了
else
if outOfBounds (x,y)
then do
putStrLn "illegal position"
playerMan ox board -- 手が無効(盤の外)
else
let
(done,newBoard) = doMove ox (x,y) board -- 指定された石を置く
in
if done
then return (done,newBoard)
else do
putStrLn "illegal position"
playerMan ox board
-------------------------------------------------------------------------------
-- 勝ったか？
-------------------------------------------------------------------------------
isWin:: Piece -> Board -> Bool
isWin ox board =
any (\pts -> isAllSameColor pts)
[
[(0,0),(0,1),(0,2)],
[(1,0),(1,1),(1,2)],
[(2,0),(2,1),(2,2)],
[(0,0),(1,0),(2,0)],
[(0,1),(1,1),(2,1)],
[(0,2),(1,2),(2,2)],
[(0,0),(1,1),(2,2)],
[(0,2),(1,1),(2,0)]]
where
isAllSameColor pts =
-- どれか１つでもそれ以外の色ならダメ
not $ any (\pt -> getBoard board pt /= ox) pts
-------------------------------------------------------------------------------
-- ゲームの補助関数
-------------------------------------------------------------------------------
playGame':: (Piece->Board->IO(Bool,Board)) -> (Piece->Board->IO(Bool,Board)) -> Piece -> Board -> IO()
playGame' playerO playerX ox board = do
-- 局面の表示
showBoard board
if getCount board Empty == 0
-- 盤面が全て埋めつくされているか，
then putGameOver board Empty
else do
-- 一手進める
(done,newBoard) <- (if ox == O then playerO else playerX) ox board
-- 次の手番(*-player-moveが True を返した場合)
if done
then if isWin ox newBoard
then do
showBoard newBoard
putStrLn ("Winner:" ++ show ox)
else playGame' playerO playerX (opponent ox) newBoard
-- 投了(*-player-moveが False を返した場合)
else putGameOver board (opponent ox)
where
putGameOver board winner = do
putStrLn "*** GAME OVER ***"
putStrLn ("winner: " ++ (if winner == Empty then "draw" else show winner))
-------------------------------------------------------------------------------
-- ゲームを行う
-- 引数
-- playerO ○の操作を行う関数
-- playerX ×の操作を行う関数
-- playerManを使うとユーザが操作を行うことになる．
-------------------------------------------------------------------------------
playGame:: (Piece->Board->IO(Bool,Board)) -> (Piece->Board->IO(Bool,Board)) -> IO()
playGame playerO playerX =
-- gameの本体(game-auxの呼びだし)
-- 現在の状態が与えられない場合は，初期状態からスタート
playGame' playerO playerX O initBoard
-------------------------------------------------------------------------------
-- ゲームを行う
-------------------------------------------------------------------------------
main = playGame playerMan playerCom -- 人VSコンピュータ
-- main = playGame playerMan playerMan -- 人VS人
-------------------------------------------------------------------------------
-- COMプレイヤ操作関数
-- 最善と思われる手を打ち、盤面を返す。
-------------------------------------------------------------------------------
playerCom:: Piece -> Board -> IO(Bool,Board)
playerCom ox board = do
hand <- getBestHand board ox
putStrLn (show ox ++ ">> " ++ show hand)
return $ doMove ox hand board
-------------------------------------------------------------------------------
-- 空いている位置のリストを返す
-------------------------------------------------------------------------------
getHands:: Board -> [Pt]
getHands board =
[(x,y) | x<-[0..boardSize-1], y<-[0..boardSize-1], getBoard board (x,y) == Empty]
-------------------------------------------------------------------------------
-- oxを置くと勝ちになる位置のリストを返す
-------------------------------------------------------------------------------
getCheckmatePts:: Board -> Piece -> [Pt]
getCheckmatePts board ox =
[pt | pt <- getHands board, isWin ox (setBoard board pt ox)]
-------------------------------------------------------------------------------
-- 最善と思われる手を返す
-------------------------------------------------------------------------------
getBestHand:: Board -> Piece -> IO (Pt)
getBestHand board ox =
let
-- 優先度１：自分が打って勝てる場所のリスト
hands1 = getCheckmatePts board ox
-- 優先度２：相手が打つと勝つ場所のリスト
hands2 = getCheckmatePts board (opponent ox)
-- 優先度３：真ん中
hands3 = if getBoard board (1,1) == Empty
then [(1,1)]
else []
-- 優先度４：四つ角
hands4 = [pt | pt <- [(0,0),(0,2),(2,0),(2,2)], getBoard board pt == Empty]
hands = (hands1 ++ hands2 ++ hands3 ++ hands4)
in
if length hands > 0
then return $ head hands
-- ランダムに打つ
else getRandomHand board ox
-------------------------------------------------------------------------------
-- 空いている箇所にランダムに打つ
-------------------------------------------------------------------------------
getRandomHand:: Board -> Piece -> IO (Pt)
getRandomHand board ox = do
seed <- getStdGen
rs <- return $ randomRs(0,boardSize-1) seed
return $ getRandomHand' rs
where
getRandomHand' rs =
let
x = head rs
y = head $ tail rs
in
if getBoard board (x,y) == Empty
then (x,y)
else getRandomHand' (tail rs)
{-
Hugs> :l "OXGame.hs"
Main> main
- - -
- - -
- - -
O>>
1
1
- - -
- O -
- - -
X>> (0,0)
X - -
- O -
- - -
O>>
0
1
X - -
O O -
- - -
X>> (2,1)
X - -
O O X
- - -
O>>
0
2
X - -
O O X
O - -
X>> (2,0)
X - X
O O X
O - -
O>>
1
0
X O X
O O X
O - -
X>> (2,2)
X O X
O O X
O - X
Winner:X
-}