a-sanの日記

2007-01-15

○×ゲーム

前回のオセロベースに○×ゲームを作ってみました。

ルールが簡単な分、簡単にできました。

しかも、人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   -- 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 =
            -- どれか1つでもそれ以外の色ならダメ
            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
        -- 優先度1:自分が打って勝てる場所のリスト
        hands1 = getCheckmatePts board ox
        -- 優先度2:相手が打つと勝つ場所のリスト
        hands2 = getCheckmatePts board (opponent ox)
        -- 優先度3:真ん中
        hands3 = if getBoard board (1,1) == Empty
                    then [(1,1)]
                    else []
        -- 優先度4:四つ角
        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
-}