えーと、なんだっけ、n目並べを作るんだっけ。あれだよね、評価関数を作ってmin-maxとかalpha-betaとかやるんだよね。本かwebかで見たことある。
思考はおいといて、とりあえずプログラムの骨組み部分。
import System import List import Char import Text.Regex main = do args <- getArgs let [w, h] = map read args in play [Human black, AI white stupid] w h play :: [Player] -> Int -> Int -> IO () play players w h = play' (cycle players) (createBoard w h) where play' ps board = do putStr (showBoard board) let p = head ps tok = token p pos <- next p board let board' = update pos tok board if maxNarabe pos tok board' >= nmoku then win p board' else play' (tail ps) (board') win :: Player -> Board -> IO () win p board = do putStr (showBoard board) putStrLn (showToken (token p) ++ " win!") ------------------------------------------------------------------------ -- Board とかの構造 ------------------------------------------------------------------------ nmoku :: Int -- n 目並べ nmoku = 4 type Position = (Int, Int) type Token = Int blank :: Token blank = 0 black :: Token black = 1 white :: Token white = 2 type Board = [[Token]] cell :: Position -> Board -> Token cell (x, y) board = board !! y !! x rows :: Board -> [[Token]] rows = id ------------------------------------------------------------------------ -- Board handling ------------------------------------------------------------------------ -- Show のインスタンスにしたかったんだけど -- -flasgow-exts -fallow-overlapping-instances をつけてもだめだった showToken :: Token -> String showToken token | token == black = "#" | token == white = "O" | otherwise = "." showBoard :: Board -> String showBoard board = unlines $ sandwitch id [header] (zipWith formatRow [1..] (rows board)) where sandwitch f s t = s ++ t ++ f s header = " " ++ (unwords $ map (:[]) $ take (width board) ['a'..]) formatRow n row = unwords $ sandwitch reverse [show n, "|"] $ map showToken row width :: Board -> Int width = length . head . rows height :: Board -> Int height = length . rows createBoard :: Int -> Int -> Board createBoard w h = take h $ repeat $ take w $ repeat blank inBounds :: Position -> Board -> Bool inBounds (x, y) board = inBounds' x (0, width board) && inBounds' y (0, height board) where inBounds' t (s, e) = t >= s && t < e canPlace :: Position -> Board -> Bool canPlace pos@(x, y) board = inBounds pos board && cell (x, y) board == blank update :: Position -> Token -> Board -> Board update (x, y) tok = replace y (replace x (const tok)) replace :: Int -> (a -> a) -> [a] -> [a] replace pos f xs = take pos xs ++ [f (xs !! pos)] ++ drop (pos + 1) xs -- pos に tok をおいた場合に並ぶ数 maxNarabe :: Position -> Token -> Board -> Int maxNarabe (x, y) tok board = maximum $ map narabe [(1, 0), (0, 1), (1, 1)] where narabe dir = 1 + count dir + count (negate dir) negate (x, y) = (-x, -y) count (dx, dy) = length $ takeWhile (\pos -> inBounds pos board && cell pos board == tok) $ map (\n -> (x + dx * n, y + dy * n)) [1..] ------------------------------------------------------------------------ -- Player ------------------------------------------------------------------------ data Player = Human Token | AI Token Eval -- 評価関数 type Eval = Token -> Board -> Score type Score = Int token :: Player -> Token token (Human tok) = tok token (AI tok _) = tok next :: Player -> Board -> IO Position next (Human tok) board = getNext tok board next (AI tok eval) board = do let pos = thinkNext tok eval board putStrLn $ "next " ++ showToken tok ++ " : " ++ showPosition pos return pos -- ユーザーに次の手を聞く getNext :: Token -> Board -> IO Position getNext tok board = do putStr $ "next " ++ showToken tok ++ " : " input <- getLine case readPosition input of Just pos -> if canPlace pos board then return pos else getNext tok board Nothing -> getNext tok board readPosition :: String -> Maybe Position readPosition str = case matchRegex (mkRegx "^([a-z])([0-9])") str of Just [x, y] -> return (ord (head x) - ord 'a', digitToInt (head y) - 1) otherwise -> Nothing showPosition :: Position -> String showPosition (x, y) = [chr (ord 'a' + x), intToDigit (y + 1)] -- 次の手を考える thinkNext :: Token -> Eval -> Board -> Position thinkNext tok eval board = maximumFst $ map pairWithScore $ candidate board where maximumFst = snd . head . sortBy (\a b -> fst b `compare` fst a) pairWithScore pos = (eval tok (update pos tok board), pos) candidate :: Board -> [Position] candidate board = filter (flip canPlace board) [(x, y) | x <- [0 .. width board - 1], y <- [0 .. height board - 1]] ------------------------------------------------------------------------ -- 評価関数 ------------------------------------------------------------------------ stupid :: Eval stupid tok board = 0
うーん、長いな。