goe.el

[Joe Corneli]

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