第一回 オフラインリアルタイムどう書くの回答例(2)

Tick-Tack-Toeの判定をHaskellで書き直してみたコード。2時間くらいかかった気がする。置いとけばフルボッコ・・・いや、誰かが勝手に採点してくれるんじゃないかと期待。

gistにも置いた。

tick_tack_toe_test.hs

import Test.HUnit
import TickTackToe

parseLine :: String -> (String, String, String)
parseLine line = let (num, left) = break (== '\t') line
                     (input, output) = break (== '\t') $ tail left
                 in (num, input, tail output)

runAllTest :: [(String, String, String)] -> IO ()
runAllTest testCases = do
  let tests = TestList $ fmap testLabel testCases
  runTestTT tests
  return ()
    where testLabel (num, input, output) =
              TestCase $ assertEqual num output (solve input)

main :: IO ()
main = do
  contents <- readFile "tick_tack_toe_test_case.tsv"
  let testCases = fmap parseLine $ lines contents
  runAllTest testCases

TickTackToe.hs

module TickTackToe (solve) where

data Player = Player { name :: String }
              deriving (Eq, Show)
data Cell = Empty | Owned Player
            deriving (Eq, Show)
data Result = Draw | Winner Player | Faul Player
              deriving (Eq, Show)
type Point = (Int, Int)
type Board = [[Cell]]

solve :: String -> String
solve input = case process input' (head players) (initialBoard size) of
                Draw -> "Draw game."
                Winner p -> (name p) ++ " won."
                Faul p -> "Foul : " ++ (name $ nextPlayer p) ++ " won."
    where
      input' = take (size * size) input
      process :: String -> Player -> Board -> Result
      process [] _ _ = Draw
      process (x:xs) player board =
          let pt = numberToPoint (read $ x : "") size
          in
            case checkBoard board pt of
              Owned _ -> Faul player
              Empty -> let nextBoard = putBoard board pt player
                       in if (checkHorizontal nextBoard pt ||
                              checkVertical nextBoard pt ||
                              checkDiagonal nextBoard pt)
                          then Winner player
                          else process xs (nextPlayer player) nextBoard

size :: Int
size = 3

initialBoard :: Int -> Board
initialBoard s = replicate s $ replicate s Empty

numberToPoint :: Int -> Int -> Point
numberToPoint n s = (n' `div` s, n' `mod` s)
    where n' = n - 1

putBoard :: Board -> Point -> Player -> Board
putBoard board pt player = fmap processRow $ zip board [0..]
    where processRow (row, y) = fmap ( \(cell, x) ->
                                           if (x, y) == pt
                                           then Owned player
                                           else cell ) $
                                zip row [0..]

checkBoard :: Board -> Point -> Cell
checkBoard board (x, y) = (board !! y) !! x

players :: [Player]
players = [Player "o", Player "x"]

nextPlayer :: Player -> Player
nextPlayer player = nextPlayer' players player
    where nextPlayer' (x:y:ys) p =
              if x == p then y else nextPlayer' (y:ys) p
          nextPlayer' _ _ = head players

checkHorizontal :: Board -> Point -> Bool
checkHorizontal board (_, y) = isOccupied line
    where line = board !! y

checkVertical :: Board -> Point -> Bool
checkVertical board (x, _) =  isOccupied line
    where line = fmap (!! x) board

checkDiagonal :: Board -> Point -> Bool
checkDiagonal board (x, y) = x == y && isOccupied diagonalA
                             || x == (bSize - y - 1) && isOccupied diagonalB
    where diagonalA = fmap (\i -> checkBoard board (i, i)) [0..2]
          diagonalB = fmap (\i -> checkBoard board (i, bSize - i - 1)) [0..2]
          bSize = length board

isOccupied :: [Cell] -> Bool
isOccupied line = isOccupied' (head line) line
    where isOccupied' _ [] = True
          isOccupied' cell (x:xs) =
              if cell /= x then False else isOccupied' cell xs

Haskell はトップダウンで書いていくときに、型が強力なメモ代わりになってくれるのが面白い感覚だった。まだ書いてない関数でも、型さえ適切に決めておけば安心してガシガシ組み立てられるのが嬉しい。

##追記

t_uchidaさんの回答。

• toEnumとfromEnum便利
• filter から insertの流れがすてき
• drop と take と iterate の使い方が巧妙
• transpose はともかく斜めを作るのは zipWith かあ