○×ゲーム
オセロをベースに○×ゲームを作ってみました。
ルールが簡単な分、簡単にできました。
しかも、人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 -}