[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
goe.el
From: |
Joe Corneli |
Subject: |
goe.el |
Date: |
Sat, 13 Nov 2004 03:37:35 -0600 |
I thought it would be fun to write a go program in lisp.
I'm not done, but I do have a functional goban.
The next step I'd like to add is "simple" -- counting the final
score. This simple step seems to require not-inconsiderable go
knowledge.
Anyone interested in helping?
;;; goe.el -- go in emacs lisp
;; Copyright (C) 2004 Joe Corneli <address@hidden>
;; Time-stamp: <jac -- Sat Nov 13 03:32:30 CST 2004>
;; This file is not part of GNU Emacs, but it is distributed under
;; the same terms as GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 2, or (at your
;; option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; A far more honest description would be "Goban in Emacs Lisp".
;; For now.
;; This would be a fun thing to play over the network if I can ever
;; get the "multiplayer editing" stuff set up.
;; Functionality is not yet complete; we should count the score
;; automatically at the end of the game -- or at least give some
;; assistance on counting! Also one should be able to toggle between
;; play mode and a freeform editing mode. Game histories (and ko rule
;; compliance checking), a clock, and a computer opponent would be fun
;; to add too.
;; In addition to standard go, this program also supports some
;; nonstandard play: boards of any size, and up to four players.
;; (Insofar as the program supports anything.)
;; "I am goe.el and I endorse this message."
;;; Code:
(require 'cl)
(defvar board nil)
(defvar board-size 19)
(defvar turn 0)
(defvar number-of-players 2)
(defvar goeban-position 1)
(defvar current-player 1)
(defvar prisoners '(0 0 0 0 0 0))
(defvar pass-count 0)
(defvar game-over-p nil)
(defun initialize-board (n)
"Make an N by N go board."
(interactive "nSize: ")
(setq board nil)
(setq board-size n)
(setq prisoners '(0 0 0 0))
(setq current-player 1)
(setq turn 0)
(setq pass-count 0)
(setq game-over-p nil)
(let ((i 0))
(while (< i n)
(setq board (append board
(let ((j 0)
row)
(while (< j n)
(setq row (append row (list 0))
j (1+ j)))
(list row)))
i (1+ i))))
(display-board))
(defun get-stone (i j)
(car (nthcdr (1- j) (car (nthcdr (1- i) board)))))
;; This is the lowest level function... it doesn't deal with prisoners
;; or anything complicated!
(defun set-stone (i j color)
"Place a stone at position I J, with given COLOR."
(rplaca (nthcdr (1- j) (car (nthcdr (1- i) board)))
color))
;; the way this would work. check the most-recently placed stone to
;; see if it is a capturing move. (Alternatively, we could check
;; each group of stones to see if they are in atari, then we would
;; know where the ataris are and so we know what the capturing moves
;; are!) To do this, count the number of liberties of groups that
;; touch this stone and see if the number is zero (in fact, we can
;; stop with this group if the number of liberties is ever seen
;; to be greater than 1.
;;
;; Determining whether a given group has liberties is implemented by
;; the following recursive proceedure: Check adjacent stones for
;; liberties or connections to other stones. If a liberty is
;; encountered, return true. Else, if connection, return value of
;; recursive call with shifted to focus to connected stone(s).
;;
;; Elements the a group being investigated should be added to a
;; list, so that we will have something to delete when the recursion
;; is over... assuming some group has been captured. This poses
;; some interesting question about cycles... but I think if we go
;; depth first, that will be OK. Maybe to save time, keep the id's
;; of all stones that have been investigated, so that one doesn't
;; re-investigate groups that have already been checked.
(defun remove-any-prisoners (stone)
(dolist (neighb (neighboring-positions stone))
(when (> (get-stone (car neighb)
(cdr neighb))
0)
(let ((neighb-group (assemble-max-connected-group neighb)))
(when (eq (count-liberties neighb-group) 0)
(let ((current-prisoner-count (nth current-player prisoners)))
(rplaca (nthcdr current-player prisoners)
(+ current-prisoner-count
(length neighb-group)))
(remove-group neighb-group)))))))
(defun assemble-max-connected-group (stone)
"Return the largest group of same-colored stones connected to STONE."
(let ((group (list stone))
(color (get-stone (car stone)
(cdr stone))))
(assemble-max-connected-group-2 stone group color)))
(defun assemble-max-connected-group-2 (stone group color)
"Recursion for `assemble-max-connected-group'."
;; for each of connected neighbor of ELT we haven't encountered before...
(let ((new-elements (delete-if (lambda (neighb)
(member neighb group))
(connected-neighbors-2 stone color))))
(setq group (append group
;; add ELT to the group
new-elements))
;; and, for each new element, recur, adding whatever is
;; found in the recursion to the group.
(dolist (elt new-elements)
(setq group (assemble-max-connected-group-2 elt group color))))
group)
(defun connected-neighbors (stone)
"Find the neighbors of STONE that have the same color."
(let ((color (get-stone (car stone)
(cdr stone))))
(connected-neighbors-2 stone color)))
(defun connected-neighbors-2 (stone color)
"Find the neighbors of STONE that have the same COLOR."
(delete-if-not (lambda (neighb)
(equal color
(get-stone (car neighb)
(cdr neighb))))
(neighboring-positions stone)))
(defun count-liberties (group)
"Return the number of liberties of this GROUP of stones.
GROUP is a list of stones; typically the group is connected."
(let ((neighbors nil))
(dolist (stone group)
(setq neighbors (append neighbors (neighboring-positions stone))))
(count 0
(mapcar (lambda (elt)
(get-stone (car elt)
(cdr elt)))
(remove-duplicates neighbors)))))
(defun neighboring-positions (position)
(let* ((a (car position))
(b (cdr position))
(Na (1- a))
(Nb b)
(Ea a)
(Eb (1+ b))
(Sa (1+ a))
(Sb b)
(Wa a)
(Wb (1- b))
(neighbs nil))
(when (and (> Na 0) (> Nb 0)
(<= Na board-size) (<= Nb board-size))
;; there's got to be a better idiom than this
(setq neighbs (append neighbs (list (cons Na Nb)))))
(when (and (> Ea 0) (> Eb 0)
(<= Ea board-size) (<= Eb board-size))
(setq neighbs (append neighbs (list (cons Ea Eb)))))
(when (and (> Sa 0) (> Sb 0)
(<= Sa board-size) (<= Sb board-size))
(setq neighbs (append neighbs (list (cons Sa Sb)))))
(when (and (> Wa 0) (> Wb 0)
(<= Wa board-size) (<= Wb board-size))
(setq neighbs (append neighbs (list (cons Wa Wb)))))
neighbs))
(defun remove-group (group)
(dolist (elt group)
(remove-stone (car elt)
(cdr elt))))
(defun remove-stone (i j)
(set-stone i j 0))
(defun move-black-stone (i j)
(set-stone i j 1))
(defun move-white-stone (i j)
(set-stone i j 2))
(defun move-grey-stone (i j)
(set-stone i j 3))
(defun move-red-stone (i j)
(set-stone i j 4))
(defun clear-board ()
(interactive)
(let ((lim (1+ (length board)))
(i 1))
(while (< i lim)
(let ((j 1))
(while (< j lim)
(remove-stone i j)
(setq j (1+ j))))
(setq i (1+ i))))
(display-board))
; (insert (substring 0 N "ABCDEFGHJKLMNOPQRSTUVWXYZ")
; (insert (padded-num (format "%s" (1+ i))))
(defun display-board ()
(interactive)
(pop-to-buffer (get-buffer-create "*Goeban*"))
(delete-region (point-min) (point-max))
(let ((lim (1+ (length board)))
(i 1))
(while (< i lim)
(let ((j 1))
(while (< j lim)
(let ((curstone (get-stone i j)))
(insert " " (cond ((eq 0 curstone)
".")
((eq 1 curstone)
"X")
((eq 2 curstone)
"O")
((eq 3 curstone)
"G")
((eq 4 curstone)
"R"))))
(setq j (1+ j))))
(insert "\n")
(setq i (1+ i))))
(insert "\n\n Turn: " (int-to-string (1+ turn)))
(unless game-over-p
(insert "\n To move: " (player-name current-player)))
(insert "\n")
(let ((i 1))
(while (<= i number-of-players)
(let ((num (nth i prisoners)))
(when (> num 0)
(insert "\n " (player-name i)
"'s prisoners: " (int-to-string num))))
(setq i (1+ i))))
(when game-over-p
;; in addition to printing this message, we should
;; print a summary of the score.
(insert "\n\n Game over."))
(goto-char goeban-position))
(defun player-name (player-number)
(cond ((eq 1 player-number)
"Black")
((eq 2 player-number)
"White")
((eq 3 player-number)
"Grey")
((eq 4 player-number)
"Red")))
;; this should update some variables that keep track
;; of who has passed (to be used in determining when
;; the game ends). There should also be a function
;; `goe-resign' that forfeits the game.
(defun goe-pass ()
(interactive)
(setq pass-count (1+ pass-count))
(if (eq pass-count number-of-players)
(game-over)
(update-turn))
(display-board))
(defun game-over ()
;; this function should set the final scores. To do this, look at
;; the groups of empty points. Determining which stones have been
;; abandoned inside of enemy territory involves a little topological
;; calculation. What should this calculation be? Some other go
;; programs ask the users to agree to their assessment of which
;; stones are dead at the end of the game. So the simplest cop-out
;; would be to mark prisoners (and if I felt in a hurry to "finish"
;; the program, I'd have to do it this way)... but it would be nicer
;; by far to have the program determine which stones are dead
;; automatically! After all, an AI for this game _should_ know
;; which groups are alive and which are dead. (However I do think
;; that there is some room for debate in the official rule set.)
;;
;; First thing to identify is: indepenent groups of empty points.
;; What color(s) border these groups? If it is all one color, can
;; that group make life? This is the hard part.
;;
;; If two independent empty groups map to one connected nonempty
;; group, then I think that group is guaranteed to be alive. (It
;; need not be the case that these empty groups map to _exactly_ one
;; connected non-empty group; the empty groups are "life" so long as
;; there exists one such non-empty group.) However, this is not an
;; if-and-only if condition, because sometimes one encounters a
;; large piece of area that is adjacent to only one connected group,
;; and that group is adjacent to no other piece of area, but the one
;; large piece of area is to be counted as territory, because life
;; _could_ be made. So this gives another condition for being
;; counted as territory: be surrounded by stones of one color and be
;; a "large enough" area. (Of course, the surrounding stones need
;; to NOT make false eyes.)
;;
;; Example: how to tell that the group in the lower right is alive,
;; but the group in the upper left is not?
;;
;; . . X . O . . O .
;; . X O O O . O O O
;; . X O . . . O . O
;; X X X O O O X O O
;; X O O O . O X X X
;; O . . . O X X . .
;; . O O . O O X . .
;; . . . O X X X . .
;; . . O X X . . . .
;;
(setq game-over-p t))
(defun update-turn ()
(setq turn (1+ turn))
(setq current-player (1+ (mod turn number-of-players))))
(defun padded-num (str)
"Require two-character-long, space-padded decimal numbers.
Argument STR is either one or two characters long to begin with."
(if (eq (length str) 2)
str
(concat " " str)))
(defun place-current-stone ()
(interactive)
(cond
;; one can only move on empty points! (and can't
;; put a stone anywhere off the board)
((looking-at "\\.")
(let ((row (line-number-at-pos))
(col (detect-column-number)))
(set-stone row col (1+ (mod turn number-of-players)))
;; this shouldn't be executed when we are in free-form
;; editing mode
(remove-any-prisoners (cons row col)))
(setq pass-count 0)
(update-turn))
(t nil))
(setq goeban-position (point))
(display-board))
(defun detect-column-number ()
(1+ (string-to-int
(replace-regexp-in-string
" *"
""
(count-matches "[^ ]"
(line-beginning-position)
(point))))))
;; this should be rewritten to work with boards of any size.
(defun place-handicap-stones (k)
"Place K black handicap stones in the traditional places."
(cond ((eq k 9)
(move-black-stone 4 4)
(move-black-stone 16 16)
(move-black-stone 4 16)
(move-black-stone 16 4)
(move-black-stone 4 10)
(move-black-stone 10 4)
(move-black-stone 10 16)
(move-black-stone 16 10)
(move-black-stone 10 10))
((eq k 8)
(move-black-stone 4 4)
(move-black-stone 16 16)
(move-black-stone 4 16)
(move-black-stone 16 4)
(move-black-stone 4 10)
(move-black-stone 10 4)
(move-black-stone 10 16)
(move-black-stone 16 10))
((eq k 4)
(move-black-stone 4 4)
(move-black-stone 16 16)
(move-black-stone 4 16)
(move-black-stone 16 4))
(t nil)))
(define-derived-mode goe-mode fundamental-mode "Goe")
(setq goe-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "
" 'place-current-stone)
(define-key map " " 'place-current-stone)
(define-key map "p" 'goe-pass)
map))
;;; goe.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |