module TicTacToe where

import Data.Char	( digitToInt )
import Data.Tree	( Tree(..) )

-- 処理系に含まれるライブラリと同様，自前のモジュールも import 宣言で取り込む
import Mark		( Mark(..), isEmpty, next )
import Position

size :: Tree a -> Int				-- 節の個数を求める
size (Node x ts) = 1 + sum (map size ts)

depth :: Tree a -> Int				-- 木の深さを求める
depth (Node x []) = 0
depth (Node x ts) = 1 + maximum (map depth ts)

-- すべての部分木に f を適用したものから構成される新たな木を作る
mapSubTree :: (Tree a -> b) -> Tree a -> Tree b
mapSubTree f n@(Node x ts) = Node (f n) (map (mapSubTree f) ts)

-- x を元に，繰り返し f を適用していったものを子とする木を作る
repTree :: (a -> [a]) -> a -> Tree a
repTree f x = Node x (map (repTree f) (f x))


type GTree = Tree Position

gameTree :: Position -> GTree
gameTree pos = repTree allMoves pos

prune :: Int -> Tree a -> Tree a
prune 0     (Node x  _) = Node x []
prune (m+1) (Node x ts) = Node x (map (prune m) ts)


static :: Position -> Int
static (Pos p pss) = sum [ eval p line | line <- allLines pss ]


eval :: Mark -> [Mark] -> Int
eval p qs = eval' (count p qs)
  where
    count :: Mark -> [Mark] -> (Int,Int)
    count p [] = (0,0)
    count p (q:qs) 
      | q == p    = (a+1,b)
      | q == p'   = (a,b+1)
      | otherwise = (a,b)
      where (a,b) = count p qs
	    p' = next p
    eval' :: (Int,Int) -> Int
    eval' (0,0) = 0
    eval' (a,0) = 10^a
    eval' (0,b) = -10^b
    eval' (_,_) = 0


dynamic :: Int -> Position -> Position
dynamic m pos = select_pos (-x2) ts2 ts1
  where n1@(Node x1 ts1) = (prune m . gameTree) pos
	Node x2 ts2 = (mapSubTree minimax  . fmap static) n1  -- minimax版
--	Node x2 ts2 = (mapSubTree minimax' . fmap static) n1  -- α-β版(後述)

type ITree = Tree Int

select_pos :: Int -> [ITree] -> [GTree] -> Position
select_pos u (Node v _ : its) (Node p _ : gts)
  = if u==v then p else select_pos u its gts

minimax :: ITree -> Int		-- 相手の得点を最小にするような手を選択
minimax (Node x []) = x
minimax (Node x ts) = -1 * minimum (map minimax ts)


minimax' :: ITree -> Int
minimax' = bmx (-max_sval) max_sval
  where
    max_sval = 2^31 - 1		-- as Infinity

bmx :: Int -> Int -> ITree -> Int
bmx a b (Node x []) = (a `max` x) `min` b
bmx a b (Node x ts) = cmx a b ts

cmx :: Int -> Int -> [ITree] -> Int
cmx a b []     = a
cmx a b (t:ts) = if a' == b then a' else cmx a' b ts
		   where a' = - bmx (-b) (-a) t


main, main' :: IO ()
main  = tictactoe (mkPos 3 3) O
main' = tictactoe (mkPos 3 3) X

tictactoe :: Position -> Mark -> IO ()
tictactoe pos p0
  = do putStr $ show pos
       (if p0 == O then loop0 else loop1) pos
  where
    loop0 pos			-- ユーザの手番
      = do putStr "XY : "
           (c1:c2:_) <- getLine
	   let [x,y] = map digitToInt [c1,c2]
	   let pos' = updatePosition (x-1,y-1) pos
	   putStr $ show pos'
	   finGame loop1 pos'
    loop1 pos			-- 計算機の手番
      = do putStr "\n"
           let pos' = dynamic prune_val pos
	   putStr $ show pos'
	   finGame loop0 pos'
	where prune_val = 5
    finGame next_loop pos
      | winlosegame pos = putStrLn $ "You " ++ if p==p0 then "lose." else "win!"
      | drawgame pos    = putStrLn "Game is draw."
      | otherwise       = next_loop pos
      where p = turn pos

