Так - для размышлений на тему очередного алгоритма игры на функциональном языке.
Что за язык - определите сами, подсказывать не буду.
И так код:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Go where
import Data.List
import Control.Monad.State
-- article 1a: Go is played on a 19x19 square grid of points
size = 19
coords = [1..size]
type Point = (Int,Int)
points = [(x,y) | x<-coords, y<-coords]
-- article 1b: by two players called Black and White
data Player = Black | White deriving (Eq, Show)
-- article 2: Each point on the grid may be colored black, white or empty.
data Color = Empty | Stone Player deriving (Eq, Show)
type Position = Point -> Color
-- article 3b: if there is a path of (vertically or horizontally) adjacent points of P's color from P
neighbours (x,y) = [(x,y1) | y1<-neighbours1 y] ++
[(x1,y) | x1<-neighbours1 x] where
neighbours1 z = [pred z | z/=1] ++ [succ z | z/=size]
string pos point = join (expand [[point],[]]) where
expand l@(curr:prev:_) = if (null next) then l else expand (next:l) where
next = nub [nbr | nbr <- curr>>=neighbours, pos nbr==pos point] \\ prev
-- article 4: Clearing a color is the process of emptying all points of that color
clear pos points = \pt -> if pt `elem` captured then Empty else pos pt where
captured = join [str | pt<-points, let str=string pos pt, null (liberties pos str)]
-- article 4b: that don't reach empty.
liberties pos group = nub [nbr | nbr<-group>>=neighbours, pos nbr==Empty]
-- article 5a: Starting with an empty grid
emptypos = const Empty
-- article 5b: the players alternate turns, starting with Black.
results turns = evalState (sequence $ zipWith play (cycle [Black,White]) turns) [emptypos]
-- article 6a: A turn is either a pass; or a move
data Turn = Pass | Move Point deriving (Show)
-- article 6b: that doesn't repeat an earlier grid coloring.
data GoError = Occupied | Superko Int deriving (Eq, Show) -- cycle length
testko pos past noko = case elemIndex (map pos points) (map (`map` points) past) of
Just i -> return $ Left $ Superko (1+i)
Nothing -> noko
-- article 7: A move consists of coloring an empty point one's own color; then clearing the opponent color, and then clearing one's own color.
move player point pos = pos3 where
pos1 = \pt -> if pt==point then (Stone player) else pos pt
opponent = [nbr|nbr<-neighbours point, (Stone p)<-[pos1 nbr], p/=player]
pos2 = clear pos1 opponent
pos3 = clear pos2 [point]
play player Pass = do
past@(pos:_) <- get
put (pos:past)
return $ Right $ show (length past) ++ ". " ++ show player ++ " pass\n" ++ gameover past
play player (Move point) = do
past@(pos:_) <- get
let pos' = move player point pos
if pos point /= Empty then return (Left Occupied) else let
pos' = move player point pos
in testko pos' past $ do
put (pos':past)
return $ Right $ show (length past) ++ ". " ++ show player++" "++show point++"\n\n"++showpos pos'
-- article 8: The game ends after two consecutive passes.
gameover (pos:pos':_) | map pos points == map pos' points = "\nGame Over. Black: " ++ show bscore ++ " White: " ++ show wscore ++ ". " ++ winner bscore wscore ++ "\n" where
(bscore, wscore) = (score pos Black, score pos White)
gameover _ = ""
-- article 9: A player's score is the number of points of her color, plus the number of empty points that reach only her color.
score pos player = sum $ map scorepoint points where
scorepoint pt = case pos pt of
Stone p | p == player -> 1
| otherwise -> 0
Empty | owners == [player] -> 1
| otherwise ->0 where
owners = nub [p|(Stone p)<-string pos pt>>=neighbours>>=return.pos]
-- article 10: The player with the higher score at the end of the game is the winner. Equal scores result in a tie.
winner bscore wscore = case compare bscore wscore of
LT -> "White wins."
EQ -> "It's a tie."
GT -> "Black wins."
-- show stuff
showpos pos = unlines (map showrow (reverse coords)) where
showrow y = ' ':intersperse ' ' [tochar (pos(x,y))|x<-coords]
tochar (Stone Black) = '@'
tochar (Stone White) = 'O'
tochar Empty = '.'
showgame game = do
putStrLn $ showpos emptypos
mapM_ (putStrLn . either (error.show) id) (results game)
-- example game
game = [Move (2,1), Move (2,3), Move (2,2), Move (3,2), Move (1,2), Pass, Pass]
main = showgame game
Довольно таки просто, наглядно,. дёшево, сердито.
И главное не долго, да и не дорого...
почти за дармА
Ну что это за Жизнь... без примеси сумасшествия совсем не интересно......
[
www2.psy.uq.edu.au]
[
www.mercury.csse.unimelb.edu.au] - Крутой Меркурий
[
habrahabr.ru]
[
shogi.by] - Shuogi
