読み書きプログラミング

日常のプログラミングで気づいたことを綴っています

マルペケ

Haskellでマルペケの結果を数え上げてみました。

--- Tic-Tac-Toe
-- by ICHIKAWA, Yuji
-- 2009 Copyleft ICHIKAWA, Yuji
-- initial version 2009/02/11
-- refactoring 2009/02/16

module Main where
import Ix
import qualified Data.Map as Map
import Data.Tree
import qualified Data.Set as Set

data Player = X | O deriving (Eq, Show)
type Position = (Int, Int)
type Snapshot = Map.Map Position Player
type GameTree = Tree Snapshot

main = do
    putStrLn "calculating statistics of Tic Tac Toe..."
    putStrLn "[number of X's Win, number of O's win, number of draws]"
    print $ gameStatistics $ gameTree Map.empty

choices :: Snapshot -> [Snapshot]
choices s
 | didWin s last = [] 
 | otherwise = map move [x | x <- range ((1, 1), (3, 3)), Map.notMember x s]
 where
    last = if odd (Map.size s) then X else O
    next = if odd (Map.size s) then O else X
    move position = Map.insert position next s

gameTree s = unfoldTree (\x -> (x, choices x)) s

didWin :: Snapshot -> Player -> Bool
didWin s p = let
    winPatterns :: [Set.Set Position]
    winPatterns = [Set.fromList [(1, 1), (1, 2), (1, 3)],
                   Set.fromList [(2, 1), (2, 2), (2, 3)],
                   Set.fromList [(3, 1), (3, 2), (3, 3)],
                   Set.fromList [(1, 1), (2, 1), (3, 1)],
                   Set.fromList [(1, 2), (2, 2), (3, 2)],
                   Set.fromList [(1, 3), (2, 3), (3, 3)],
                   Set.fromList [(1, 1), (2, 2), (3, 3)],
                   Set.fromList [(1, 3), (2, 2), (3, 1)]]
    positionsOfP = Map.keysSet $ Map.filter (== p) s
 in any (\x -> Set.isSubsetOf x positionsOfP) winPatterns

-- returns [number of X's Win, number of O's win, number of draws]
gameStatistics :: GameTree -> [Int]
gameStatistics (Node snapshot [])
 | even (Map.size snapshot) = [0, 1, 0]
 | ((Map.size snapshot) < 3*3 || (didWin snapshot X)) = [1, 0, 0]
 | otherwise = [0, 0, 1]
gameStatistics (Node snapshot forest)
 | otherwise = foldr1 (zipWith (+)) $ map gameStatistics forest

勝利判定がかっこ悪いが、とりあえず、ゲームツリーを作ってしまってから、処理をさせることは覚えた。(処理がしらみつぶしだから遅延評価の恩恵はないけれど。)