home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lisp
/
interpre
/
xlispplu
/
fun
/
game.lsp
< prev
next >
Wrap
Text File
|
1987-06-02
|
44KB
|
890 lines
;;;;
;;;; UFG Version 1.1, Copyright (c) 1987, by Hans DeHartog.
;;;; Distribution granted for non-commercial use.
;;;;
;;;; Universal Functions for Game-playing
;;;; ------------------------------------
;;;;
;;; UFG consist of a set of Lisp-functions, which can play games.
;;;
;;; Universality: Any 2-person game can be implemented by adding
;;; a small set of clearly specified functions (see
;;; below).
;;;
;;; Goals: Robustness, portability, functionality, size
;;; (small games should run on small systems).
;;;
;;; Non-goals: Speed (should be taken care of by selecting
;;; the right hardware, now or in the future).
;;; Fancy screen-i/o (makes you highly non-portable).
;;;
;;; Implementation: Written in elementary Common Lisp. Somewhat
;;; consideration has been given to write things
;;; in a clear and portable way without using the
;;; more exotic features of Common Lisp, probably
;;; at the cost of speed.
;;;
;;; Algorithm: Minimax algorithm, Alpha-Beta-cut-offs,
;;; progressive deepening and feed-over.
;;;
;;; Features: Theory handling (book of openings), showing
;;; evaluations, advise on next move, escape to
;;; Lisp, role-switching, save/restore situations,
;;; strength-control with respect to time or depth,
;;; taking back moves, recognition of repetition of
;;; moves.
;;;
;;; Any two-person game can be played by this program. The functions in
;;; this file provide a general game-playing function with the features
;;; mentioned above. Game-specific functionality should be provided by
;;; the user with a set of functions with the following specifications:
;;;
;;; Function Argument(s) Return-type
;;; -------------------------------------------------
;;; INITIALIZE (none) BOARD
;;; PRINT-BOARD BOARD (not used)
;;; GENERATE-MOVES list of BOARDs list of MOVEs
;;; MAKE-MOVE MOVE, BOARD new BOARD
;;; EVALUATE list of BOARDs NUMBER
;;; CURRENT-PLAYER BOARD SYMBOL or STRING
;;;
;;; The types BOARD and MOVE can be any data-structure that can be
;;; bound to a variable by SETQ, compared for equality by EQUAL,
;;; printed by PPRINT and after that succesfully read in again by
;;; the standard function READ.
;;; List of BOARDs actually means the history of all BOARDS (the CAR
;;; being the most recent). This can be used for doing special things
;;; when repetition of moves occurs.
;;; Furthermore, the user should provide two global variables called
;;; *INFINITE*, which contains the highest value that EVALUATE can
;;; return, and NAME-OF-THE-GAME (a string that is the name of the
;;; game (e.g. "Chess", "GO" or "Kalah").
;;; If (EVALUATE BOARDs) returns *INFINITE*, it is assumed that the
;;; current player has won the game (minus *INFINITE* means loss).
;;; Note also that EVALUATE should always consider the situation from
;;; the current player (who's turn it is).
;;; Finally, the user should supply a file in the working directory,
;;; that contains a short (preferably not more than 20 lines) text,
;;; describing the rules of the game. The file-name should be a con-
;;; catenation of the name of the game and ".rls" (e.g. "chess.rls").
;;; It is recommended that the data-structure for a MOVE is kept quite
;;; simple because the user has to type it in when he types a move.
;;; Experiences so far indicate that even a dotted pair, .e.g (E2 . E4),
;;; is too difficult for some people. You better convert vice versa to
;;; a symbol: E2-E4 or E2E4.
;;; For more information, see the description of the global variables.
;;;;
;;;; Globals
;;;; =======
;;;; Here are the global variables for this program. Note that the user
;;;; who supplies the game-specific functions does not need any of those.
;;;; All the information he needs is given by arguments to his functions.
;;;;
;;; First the board and the history. Typically, BOARD always points to
;;; the CAR of HISTORY. Because it is frequently used, we've created a
;;; special variable for it instead of taken the CAR every time.
;;; BOARD is initialized by the user-routine INITIALZE. Initially,
;;; HISTORY is set to the the list of one BOARD.
(DEFVAR BOARD (INITIALIZE))
(DEFVAR HISTORY (LIST BOARD))
;;; BOARDS-TO-KEEP determines how long we keep the old situations.
;;; If non-negative, it determines the number of situations that will
;;; be kept in HISTORY. This can be set by the "keep"-command. So, KEEP 1
;;; means: 1 board will be saved (this could be done for 'irreversible'
;;; games like kalah or go). Note that this nullifies the possibility
;;; of the "undo"-command and the possibility to recognize repetition
;;; of moves throughout the history.
;;; As 0 is a useless value in this case, it means: save everything.
;;; Negative values are not used. However, a negative value (-n) to the
;;; "keep"-command means a one-time-only cut-off of the history to the
;;; length n. This can be usefull after captures, which normally mean
;;; that previous situations can not occur anymore.
(DEFVAR BOARDS-TO-KEEP 0)
;;; LIST-OF-MOVES always contains the list of moves that are possible
;;; in the current situation (indicated by BOARD). When the program
;;; has to figure out a move, this list is reordered by trying to have
;;; the best move in front of the list.
;;; This list is also used to check if the user gave a legal move (i.e.
;;; if his ANSWER is a member of this list). Any heuristics in the user
;;; supplied functions with respect to move-generation should not omit
;;; legal but worthless moves from the list but put them at the end of
;;; the list. On the other hand, it is occasionally allowed to enter an
;;; illegal move in the list for the only reason that it would take too
;;; much time to check for legality of that move.
(DEFVAR LIST-OF-MOVES)
;;; SHOW-EVALUATIONS-P is a toggle-switch (T or NIL) which determines if
;;; we are showing evaluations of moves while thinking. This switch will
;;; be flipped by the "eval"-command.
(DEFVAR SHOW-EVALUATIONS-P T)
;;; BELL-P controls ringing the bell when user has to type a command or
;;; a move. Initially it is on (T), but can be switched off by the
;;; "bell"-command.
(DEFVAR BELL-P T)
;;; The players. They are supposed to have names, e.g. BLACK and WHITE,
;;; A and B, NORTH and SOUTH. The way to find out the name of the cur-
;;; rent player, is by the user-supplied function with the same name.
;;; BOARD contains the initial situation, so PLAYER1 will be the first
;;; player to move.
(DEFVAR PLAYER1 (CURRENT-PLAYER BOARD))
;;; Its more difficult to find out the name of the other player because
;;; it is not his turn, so no function will give us directly his name.
;;; So, what we have to do is the following: generate the moves from the
;;; initial situation, take the first one, make that move and finally
;;; call the function CURRENT-PLAYER. This should be the name of the
;;; second player. While we're doing this, we also bind LIST-OF-MOVES.
;;; Note that after this, we've already used most of the user-supplied
;;; functions. Therefore, any severe errors by the user are likely to
;;; show up immediately.
(DEFVAR PLAYER2
(CURRENT-PLAYER
(MAKE-MOVE (CAR (SETQ LIST-OF-MOVES (GENERATE-MOVES HISTORY))) BOARD)))
;;; Next two variables are for keeping the times that were used by both
;;; players. Units of measurement are seconds. These are not used for
;;; determining if somebody looses because he used too much time.
;;; They are used for strength-control (if not controlled by depth) and
;;; they will be shown after every PRINT-BOARD. There values are com-
;;; pletely irrelevant after an "undo"-command and strength-control
;;; should be by means of depth-restriction (if any).
(DEFVAR PLAYER1-TIME 0)
(DEFVAR PLAYER2-TIME 0)
;;; The MOVE-COUNTER is not only an administrative variable. It is also
;;; used for strength control (by time). MOVE-COUNTER is incremented
;;; after a move by the second player, so it always denotes the move
;;; that has to be done. After the "undo"-command, the value of this
;;; variable is probably of no use anymore to control the strength by
;;; time-constraints.
(DEFVAR MOVE-COUNTER 1)
;;; Strength-control is done by one single variable: TIME-OR-DEPTH-LIMIT.
;;; It can be changed by the human player with the "sets"-command.
;;; If TIME-OR-DEPTH-LIMIT is negative (e.g. -6), the strength of this
;;; program is simply 'brute-force with depth 6'. So, negative values
;;; simply set depth-limits. As depth 1 is not usefull, setting the
;;; strength to -1 has the special effect of 'infinite' depth, i.e. the
;;; programs 'thinks' until the end of the game has been reached...
;;; With positive values, the strength is dependent on the value AND the
;;; amount of time that is used by the opponent. If TIME-OR-DEPTH-LIMIT
;;; is 20, it means that this program tries to do one move in every 20
;;; seconds. However, if the opponent uses more time, the program will
;;; do the same. The formula used to determine the amount of time that
;;; is available for a move can be found at the start of function THINK.
;;; The initial value of zero means "blitz-game", i.e. the program tries
;;; to use less time than his opponent. However, for non-negative values
;;; of this variable, there exists always a chance that the program will
;;; exceed the expected time because of the "feed-over"-feature.
(DEFVAR TIME-OR-DEPTH-LIMIT 0)
;;; BOTTOM-OF-TREE-P is a simple variable to check within the function
;;; THINK, if we reached the bottom of the search-tree (i.e. if we have
;;; reached the end of the game. It is initialized and checked in THINK
;;; and possibly changed in the function ANALYZE.
(DEFVAR BOTTOM-OF-TREE-P)
;;; The next global variable determines the role of this program in the
;;; game. If NIL, the program does not participate in the game but keeps
;;; checking and registrating alternate moves and does all the necessary
;;; house-keeping. When changed to the name of one of the players (by the
;;; "play"-command), the program will play the role of that player until
;;; another "play"-command is given (which means: "exchanging chairs") or
;;; until the "stop"-command is given.
(DEFVAR COMPUTER-ROLE NIL)
;;; THEORY is a list of situations (BOARDs) and (ideally) the best move
;;; in those situations. The format is simply as follows:
;;; ((BOARD1 MOVE1) (BOARD2 MOVE2) ... (BOARDn MOVEn))
;;; THEORY can be read in from a file by the "book"-command, it can be
;;; modified by the "tell"-command and it can be written out to a file
;;; by the "book"-command (got that?).
(DEFVAR THEORY NIL)
;;; Together with THEORY, there is a flag (THEORY-UPDATED-P) which
;;; determines if the THEORY has been stored in a file, or not.
;;; This flag is cleared, when the THEORY is read or written and set
;;; when the theory changes by the "tell"-command.
;;; It is used to warn the user when the program is about to exit
;;; while maybe there exists new theory that he might want to be saved.
(DEFVAR THEORY-UPDATED-P NIL)
;;; START-TIME is a variable for the time-accounting. It contains the
;;; time when a player starts to think about a move. For its initiali-
;;; zation (and time-accounting in general) we use the (probably non-
;;; standard) function CLOCK with no arguments which is supposed to
;;; return the time (i.e. wall-clock-time, NO cpu-time) since some
;;; fixed point in the past.
;;; For Unix-systems, use the return-value of the system-call TIME.
;;; For systems that provide you (lucky) with full-blown Common Lisp,
;;; you can define CLOCK as follows:
;;; (DEFUN CLOCK ()
;;; (ROUND (GET-INTERNAL-REAL-TIME)
;;; (INTERNAL-TIME-UNITS-PER-SECOND)))
(DEFVAR START-TIME (CLOCK))
;;; AUTO-MOVE-P is a toggle-switch which (if ON) make this program to
;;; continue automatically for either player whenever (s)he has just
;;; one move to choose from. Handy for games where a player has to
;;; skip a move (in which case his only move should be 'SKIP' or so).
(DEFVAR AUTO-MOVE-P T)
;;;;
;;;; M A I N F U N C T I O N
;;;;
(DEFUN GAME (&AUX TMP ANSWER)
;; This is the main-function that should be loaded after the user
;; supplied functions. It is just one 'endless' loop from which there
;; are three escapes: first by giving the "exit"-command, second exit
;; is 'the normal way-out' when the game is over (no moves are generated)
;; and third is the escape to Lisp (by the "lisp"-command). This function
;; is called dynamically at the beginning (lexically at the end).
;; Intially, welcome the user and print the situation.
(TERPRI)
(PRINC "Welcome to the game of ")
(PRINC NAME-OF-THE-GAME)
(PRINC "!")
(TERPRI)
(PRINC "For help, type HELP or RULES")
(TERPRI)
(PRINT-SITUATION)
;; Here's the 'endless' loop:
(DO ()
;; Next are the criteria for exiting this loop (and program).
;; Generate moves from the current situation if necessary. If there
;; are no moves, do the epilog (tell who wins/looses and exit).
((AND (NULL LIST-OF-MOVES)
(NULL (SETQ LIST-OF-MOVES (GENERATE-MOVES HISTORY))))
(EPILOG T (EVALUATE HISTORY)))
;; If there is only one possible move, and AUTO-MOVE-P is ON, just do
;; that move (whoever's turn it is). Otherwise, ask for a command or
;; move unless its my turn to play. In that case, "think" returns my
;; best move which is handled as if it had been typed in.
(SETQ ANSWER (COND ((AND AUTO-MOVE-P (= (LENGTH LIST-OF-MOVES) 1))
(CAR LIST-OF-MOVES))
((EQUAL COMPUTER-ROLE (CURRENT-PLAYER BOARD))
(THINK))
(T (IF BELL-P (PRINC ""))
(PRINT 'COMMAND/MOVE) (READ))))
;; Do time-accounting unless the "play"-command was given (i.e. we
;; are switching roles).
(IF (NOT (EQL ANSWER 'PLAY))
(IF (EQUAL (CURRENT-PLAYER BOARD) PLAYER1)
(SETQ PLAYER1-TIME (+ PLAYER1-TIME (- (CLOCK) START-TIME)))
(SETQ PLAYER2-TIME (+ PLAYER2-TIME (- (CLOCK) START-TIME)))))
(SETQ START-TIME (CLOCK))
;; Check if he typed a move or a command. If its a move, it must be
;; in the list of moves that had been generated at the start of the
;; main loop.
(COND ((MEMBER ANSWER LIST-OF-MOVES :TEST #'EQUAL) (TERPRI)
;; If so, do the move and do the necessary house-keeping.
;; Note, that a provision has been build in to handle the
;; case that an illegal move occurs in the list of moves.
;; In that case the function "make-move" should return NIL
;; in stead of a new situation. This is done because for
;; some games it is necessary to almost do the move before
;; you can see if it was a legal move or not (eg the suicide-
;; rule in GO).
(COND ((SETQ TMP (MAKE-MOVE ANSWER BOARD))
(PRINC MOVE-COUNTER) (PRINC ". ")
(SETQ HISTORY (CONS (SETQ BOARD TMP) HISTORY))
;; Keep history at desired length (if any).
(IF (AND (> BOARDS-TO-KEEP 0)
(> (LENGTH HISTORY) BOARDS-TO-KEEP))
(SETQ HISTORY (REVERSE
(NTHCDR (- (LENGTH HISTORY)
BOARDS-TO-KEEP)
(REVERSE HISTORY)))))
(SETQ LIST-OF-MOVES NIL)
(COND ((EQUAL (CURRENT-PLAYER BOARD) PLAYER1)
;; update move-counter every 2 plies
(SETQ MOVE-COUNTER (1+ MOVE-COUNTER))
(PRINC "... ")))
(PRINC ANSWER))
(T (PRINC "Illegal move")))
(PRINT-SITUATION))
;; Next is the dispatch-table for all the possible commands.
;; We end up here if something had been typed in that was not
;; member of LIST-OF-MOVES.
;; Note that in most cases, abbreviated commands are possible.
(T (CASE ANSWER
;; The first command is the "auto"-command which toggles
;; the switch for doing moves automatically when there
;; is only one possible move.
((AUTO AUT AU A) (SETQ AUTO-MOVE-P (NOT AUTO-MOVE-P)))
;; The second command is the "bell"-command which flips
;; a toggle-switch that controls ringing the bell when
;; the user is expected to type in a command or move.
((BELL BEL BE) (SETQ BELL-P (NOT BELL-P)))
;; Read or write the opening-book, depending on the fact
;; that the theory (i.e. a list of conses, thar car de-
;; noting the situation and the cdr the corresponding
;; move) is empty or not. Note that the theory can be
;; non-empty for two reasons: it has been read in
;; before or new situations have been added by the
;; "tell"-command.
((BOOK BOO BO)
(IF THEORY
;; Here we're writing the theory.
(COND ((NULL (SETQ ANSWER (OPENO (READ))))
(PRINC "Can't open output-file"))
(T (PPRINT THEORY ANSWER)
(CLOSE ANSWER)
(SETQ THEORY-UPDATED-P NIL)))
;; Here we're reading the theory.
(COND ((NULL (SETQ ANSWER (OPENI (READ))))
(PRINC "Can't open input-file"))
(T (SETQ THEORY (READ ANSWER))
(CLOSE ANSWER)
(SETQ THEORY-UPDATED-P NIL)))))
;; Next handles the exit-command.
((EXIT EXI EX) (EPILOG T))
;; Next is the "eval"-command which simply flips a
;; predicate.
;; The user can find out the current setting by giving
;; the "help"-command (or any other non-existing com-
;; mand or move).
((EVAL EVA EV)
(SETQ SHOW-EVALUATIONS-P (NOT SHOW-EVALUATIONS-P)))
;; The "hint"-command simply acts as if it is my turn to
;; move. Note however, that the strength-setting is in
;; effect! So, in the case of time-related strength,
;; this program will use almost all the time that is
;; available for the user. If time is no issue, the
;; "hint"-command can be used for really deep analysis
;; of the current situation by setting any depth (by
;; the "sets"-command) before giving this "hint"-command.
;; Although the implementation is simple, it has some
;; side-effect: while 'thinking', the list of currently
;; legal moves is reordered by the progressive deepening
;; strategy. Therefore, if the "play"-command is given
;; after the "hint"-command, the machine can figure out
;; the best move in less time due to the alpha-beta-cut-
;; offs.
((HINT HIN) (IF (= (LENGTH LIST-OF-MOVES) 1)
(PRINT (CAR LIST-OF-MOVES))
(PRINT (THINK))))
;; The "hist"-command simply prints all the boards in the
;; history (oldest first).
((HIST HIS)
(DOLIST (TMP (REVERSE HISTORY)) (PRINT-BOARD TMP)))
;; The "keep"-command can be used to save some space at
;; the cost of loosing historical data and decreasing
;; the number of moves you can go back with the "undo"-
;; command.
((KEEP KEE KE K)
(COND ((NUMBERP (SETQ TMP (READ)))
(COND ((>= TMP 0)
(SETQ BOARDS-TO-KEEP TMP)
(SETQ TMP (- TMP))))
(IF (> (+ TMP (LENGTH HISTORY)) 0)
(SETQ HISTORY
(REVERSE (NTHCDR (+ TMP
(LENGTH HISTORY))
(REVERSE HISTORY))))))
(T (INFORMATION))))
;; The "lisp"-command takes you back to Lisp by a simple
;; return from this main loop. For non-lisping players
;; you might consider to remove this feature...
;; To continue with the game (if possible after you
;; lisping), simply call the main function again: (game)
(LISP (RETURN))
;; The "list"-command simply gives a list of all possible
;; moves in the current situation.
(LIST (DOLIST (M LIST-OF-MOVES) (PRINC " ") (PRINC M)))
;; The "play"-command instructs this program to do the
;; next move. By repeatedly giving this command, this
;; program plays "against" itself. Although it would
;; have been easy to implement a command that does this
;; automatically, it was deliberately not done, because
;; stopping the program in that case would probably
;; require some implementation-dependent code (for
;; trapping Control-C or so).
;; Note that this "play"-command can not be abbreviated
;; for two reasons: firstly, it has a major impact on
;; the flow of the program (and the game) and secondly,
;; in the start of this main loop is another test to see
;; if the "play"-command had been given in order to see
;; if time-accounting has to be done.
(PLAY (SETQ COMPUTER-ROLE (CURRENT-PLAYER BOARD)))
;; Here are the "rest" and "save" commands to restore and
;; save situations from/to a file. If you type the file-
;; name without quotes, any lowercase characters are
;; converted to uppercase by most Lisp-implementations.
;; This is probably not what you want as a Unix-user.
((REST RES RE)
(COND ((NULL (SETQ ANSWER (OPENI (READ))))
(PRINC "Can't open input-file"))
(T (SETQ SHOW-EVALUATIONS-P (READ ANSWER))
(SETQ TIME-OR-DEPTH-LIMIT (READ ANSWER))
;; Note that we also save my role. There is no
;; danger for this program to immediately going
;; to "think" after restoring because the
;; "save"-command only could have been given
;; when it was not my turn (unless somebody
;; fiddled with the file...)
(SETQ COMPUTER-ROLE (READ ANSWER))
(SETQ PLAYER1-TIME (READ ANSWER))
(SETQ PLAYER2-TIME (READ ANSWER))
(SETQ MOVE-COUNTER (READ ANSWER))
(SETQ BOARDS-TO-KEEP (READ ANSWER))
(SETQ HISTORY (READ ANSWER))
(SETQ LIST-OF-MOVES NIL)
(SETQ BOARD (CAR HISTORY))
(CLOSE ANSWER)
(PRINT-SITUATION))))
((SAVE SAV SA)
(COND ((NULL (SETQ ANSWER (OPENO (READ))))
(PRINC "Can't open output-file"))
(T (PRINT SHOW-EVALUATIONS-P ANSWER)
(PRINC "; show-evaluations-p" ANSWER)
(PRINT TIME-OR-DEPTH-LIMIT ANSWER)
(PRINC "; time-or-depth-limit" ANSWER)
(PRINT COMPUTER-ROLE ANSWER)
(PRINC "; computer-role" ANSWER)
(PRINT PLAYER1-TIME ANSWER)
(PRINC "; player1-time" ANSWER)
(PRINT PLAYER2-TIME ANSWER)
(PRINC "; player2-time" ANSWER)
(PRINT MOVE-COUNTER ANSWER)
(PRINC "; move-counter" ANSWER)
(PRINT BOARDS-TO-KEEP ANSWER)
(PRINC "; boards-to-keep" ANSWER)
(PPRINT HISTORY ANSWER)
(CLOSE ANSWER))))
;; The "rules"-command explains the rules of the game.
;; It depends on the existence of a file supplied by the
;; creator of the game. It simply copies that file. Note
;; that we use READLN here, which is exactly the same as
;; READ-LINE in most Lisp-implementations; however, in
;; Common Lisp you have to explicitly specify a NIL-
;; result when EOF is reached. So, for Common Lisp you
;; have to define READLN as follows:
;;(DEFUN READLN (&OPTIONAL STREAM)
;; (IF STREAM (READ-LINE STREAM NIL)
;; (READ-LINE *STANDARD-INPUT* NIL)))
((RULES RULE RUL RU)
(SETQ ANSWER (STRCAT NAME-OF-THE-GAME ".rls"))
(COND ((SETQ TMP (OPENI ANSWER))
(DO ((L (READLN TMP) (READLN TMP)))
((NULL L)) (PRINC L) (TERPRI))
(CLOSE TMP))
(T (PRINC "Sorry, can't find file ")
(PRINC ANSWER))))
;; The "sets"-command controls the strength of this
;; program in playing the game. Generally, its imple-
;; mentation is a brute force technique (i.e. when given
;; enough time, it will always find the best move). Any
;; heuristics should be provided by the user-functions
;; because they are game-dependent. You can think of
;; building something non-algorithmic in the evalua-
;; tion-function or 'pre-order' the list of generated
;; moves.
((SETS SET SE) (IF (NUMBERP (SETQ ANSWER (READ)))
(SETQ TIME-OR-DEPTH-LIMIT ANSWER)
(INFORMATION)))
;; The "show"-command has been implemented for the simple
;; reason that the situation can be scrolled of you
;; screen after giving other commands.
((SHOW SHO SH) (PRINT-SITUATION))
;; The "stop"-command switches back to the initial state
;; in which this program simply checks and registrates
;; the moves of both players but doesn't do any thinking.
;; It only works after the "play"-command has been given.
((STOP STO ST)
(IF COMPUTER-ROLE (SETQ COMPUTER-ROLE NIL)
(INFORMATION)))
;; The "tell"-command adds the current situation and the
;; given move to the theory.
((TELL TEL TE) (ADD-TO-THEORY (READ)))
;; The "undo"-command backs up in history until it finds
;; a situation where the same player has to move again
;; and has at least a choice of moves (otherwise, the
;; program would do that only move right away for him).
;; Note, that some administrative chaos can result from
;; this feature, because we don't save the times and
;; move-counters separate for every situation in history.
;; However, one normally is not concerned about those
;; things when you allow people to take back their moves.
((UNDO UND UN U)
(DOLIST (B (CDR HISTORY))
(COND ((EQUAL (CURRENT-PLAYER BOARD)
(CURRENT-PLAYER B))
(SETQ TMP
(MEMBER B HISTORY :TEST #'EQUAL))
(COND ((> (LENGTH
(GENERATE-MOVES TMP)) 1)
(SETQ MOVE-COUNTER
(- MOVE-COUNTER
(DIVIDE
(- (LENGTH HISTORY)
(LENGTH TMP)) 2)))
(SETQ LIST-OF-MOVES NIL)
(SETQ HISTORY TMP)
(SETQ BOARD (CAR HISTORY))
(PRINT-SITUATION) (RETURN)))))))
;; Finally in this dispatch-table, if no legal command
;; was given and no legal move was typed, tell the user
;; about the possibilities. This is also the end of the
;; main loop and main function.
(T (INFORMATION)))))))
;;; ADD-TO-THEORY adds a situation and a corresponding move to the theory.
;;; First, the move is checked for its legality. Second, if the given situation
;;; already exists in the theory, it is removed (and the user is informed about
;;; the move being replaced). Finally, the board and move are CONS'ed to THEORY
(DEFUN ADD-TO-THEORY (MOVE &AUX TMP)
(COND ((AND (MEMBER MOVE LIST-OF-MOVES :TEST #'EQUAL)
(MAKE-MOVE MOVE BOARD))
(COND ((SETQ TMP (ASSOC BOARD THEORY :TEST #'EQUAL))
(SETQ THEORY (REMOVE TMP THEORY :TEST #'EQUAL))
(IF (NOT (EQUAL MOVE (CDR TMP)))
(PRINT `(REPLACED ,(CDR TMP))))))
(SETQ THEORY-UPDATED-P T)
(SETQ THEORY (CONS (CONS BOARD MOVE) THEORY)))
(T (PRINC "Illegal move"))))
;;; PRINT-SITUATION first calls the user-supplied function PRINT-BOARD and
;;; after that, it gives some additional information. It tells who's turn it
;;; is and reports about the time used by both players. Finally, it checks
;;; for repetition of moves.
(DEFUN PRINT-SITUATION ()
;; Although BOARD is a global variable, we have to pass it explicitly
;; to the function PRINT-BOARD.
(PRINT-BOARD BOARD)
;; In general we distinguish two cases here: the case that the program
;; plays a role in the game (in which the information can be somewhat
;; more 'personal') and the case that the program is 'passive' (in
;; which case we give 'neutral' information by mentioning the players
;; by their 'official' names).
(COND (COMPUTER-ROLE
(IF (EQUAL COMPUTER-ROLE (CURRENT-PLAYER BOARD))
(PRINC "My") (PRINC "Your"))
;; In the informal case, it is sometimes necessary to be
;; able to see what pieces belong to which player (just in
;; case that PRINT-BOARD isn't too informative about that).
(PRINC " turn with ") (PRINC (CURRENT-PLAYER BOARD))
;; Only give the times when they are used to control strength.
(COND ((>= TIME-OR-DEPTH-LIMIT 0)
(PRINC ", ")
(PRINC (IF (EQUAL COMPUTER-ROLE PLAYER1) 'I "you"))
(PRINC " used ") (PRIT PLAYER1-TIME) (PRINC ", ")
(PRINC (IF (EQUAL COMPUTER-ROLE PLAYER2) 'I "you"))
(PRINC " used ") (PRIT PLAYER2-TIME))))
(T (PRINC (CURRENT-PLAYER BOARD)) (PRINC "'s turn")
(COND ((>= TIME-OR-DEPTH-LIMIT 0)
(PRINC ", ") (PRINC PLAYER1) (PRINC " used ")
(PRIT PLAYER1-TIME) (PRINC ", ") (PRINC PLAYER2)
(PRINC " used ") (PRIT PLAYER2-TIME)))))
(IF (MEMBER BOARD (CDR HISTORY) :TEST #'EQUAL)
(PRINC ", repetition of moves...")))
;;; The function PRIT prints a time, given as a number of seconds, in the
;;; format hh:mm:ss. It is assumed that no game-player will need 60 hours or
;;; more for his game. If so, the next routine will do funny things, but for
;;; compensation you can apply for an entry in the Guinness Book of Records.
;;; The function DIVIDE in PRIT is a normal integer-divide (as in Fortran),
;;; so in simple Lisp-implementations you can replace DIVIDE by /. In pure
;;; Common Lisp however, it should be defined as (or replaced by)
;;; (DEFUN DIVIDE (X Y) (FLOOR X Y)), otherwise you will suffer from ratio's.
(DEFUN PRIT (TIME)
(COND ((< TIME 60) (PRINC TIME))
(T (PRIT (DIVIDE TIME 60)) (PRINC ":")
(IF (< (REM TIME 60) 10) (PRINC 0))
(PRINC (REM TIME 60)))))
;;; Function INFORMATION is called whenever the user did something wrong
;;; (typed an illegal move or an unknown or not uniquely abbreviated command).
;;; This function gives the user all the possible information within the
;;; realm of a general game-playing program. The first line deliberately
;;; contains an example of a move (in case the move-syntax isn't clear).
;;; For all user-modifiable variables/switches, the current value is given.
;;; Information is adapted to the current situation (e.g. the "play"- and
;;; "stop"-command). Note also that some options are mentioned only when
;;; appropiate (e.g. STOP). As this function mainly prints readable output,
;;; it is 'self-documenting'.
(DEFUN INFORMATION ()
(PRINC "Type a move, e.g. ")
(PRINC (CAR LIST-OF-MOVES))
(PRINC ", or one of the following:")
(PRINT 'AUTO) (PRINC " Toggle-switch for 'auto-move' when there")
(PRINC " is only 1 move") (CURRENT-VALUE AUTO-MOVE-P)
(PRINT 'BELL) (PRINC " Toggle-switch for ringing the bell when it is")
(PRINC " your turn") (CURRENT-VALUE BELL-P)
(PRINT 'BOOK) (PRINC "f Reads/writes theory from/to file f, if up-to")
(PRINC "-date read, else write")
(PRINT 'EVAL) (PRINC " Toggle-switch for showing evaluations")
(CURRENT-VALUE SHOW-EVALUATIONS-P)
(PRINT 'EXIT) (PRINC " Back to your favourite operating system")
(PRINT 'HINT) (PRINC " Gives suggestion for your next move (uses all")
(PRINC " your time!)")
(PRINT 'HIST) (PRINC " Prints the history of boards (oldest first)")
(PRINT 'KEEP) (PRINC "n Keeps history-size to n boards (n>0), n=0 ")
(PRINC "means infinite,") (TERPRI) (PRINC " n<0 cuts history-size to -n")
(CURRENT-VALUE BOARDS-TO-KEEP)
(PRINT 'LISP) (PRINC " Back to Lisp (continue with '(GAME)')")
(PRINT 'LIST) (PRINC " Lists possible moves in current situation")
(PRINT 'PLAY) (PRINC " Makes me play ")
(PRINC (CURRENT-PLAYER BOARD)) (PRINC "'s role")
(PRINT 'REST) (PRINC "f Restores situation from file f")
(PRINT 'RULES) (PRINC " Explains the rules of the game")
(PRINT 'SAVE) (PRINC "f Saves current situation to file f")
(PRINT 'SETS) (PRINC "n Sets strength to n seconds/ply (n >= 0)")
(PRINC " or depth to -n (n < -1)") (TERPRI)
(PRINC " -1 means depth='infinite'")
(CURRENT-VALUE TIME-OR-DEPTH-LIMIT)
(PRINT 'SHOW) (PRINC " Shows board (default after every move)")
(COND (COMPUTER-ROLE (PRINT 'STOP) (PRINC " Stops me playing ")
(PRINC COMPUTER-ROLE) (PRINC "'s role")))
(PRINT 'TELL) (PRINC "m Adds to theory that m is the best move now")
(PRINT 'UNDO) (PRINC " Back to your previous move (if possible)"))
;;; The function CURRENT-VALUE is only used by PRINT-SITUATION an prints the
;;; current value of something, converting T an NIL to ON and OFF respectivily.
(DEFUN CURRENT-VALUE (VALUE)
(PRINC ", currently ")
(PRINC (COND ((NULL VALUE) 'OFF)
((EQ VALUE T) 'ON)
(T VALUE))))
;;; The function ANALYZE is the heart of the 'thinking-mechanism' of this
;;; program. It is only called by the more general function THINK.
(DEFUN ANALYZE (DEPTH ALFA BETA HISTORY &AUX MOVES VALUE)
;; First, check if we reached the maximum depth. If so, set the global
;; variable BOTTOM-OF-TREE-P to NIL to inform the function THINK that
;; we did not yet reach 'end-of-game' and after that, use the 'static'
;; game-specific evaluation-function supplied by the user and return
;; its value.
(COND ((ZEROP DEPTH)
(SETQ BOTTOM-OF-TREE-P NIL)
(EVALUATE HISTORY))
;; Second, check if we got a NIL-situation. This is only possible
;; when an illegal move was member of the LIST-OF-MOVES. If so,
;; return *INFINITE*. The rationale behind this is as follows: in
;; most games, it is a rule that if somebody makes an illegal move,
;; his opponent wins the game. If this program is the opponent in
;; this case, it won't further consider this move.
((NULL (CAR HISTORY)) *INFINITE*)
;; Third, if there are no moves generated in the current situation,
;; the game is probably finished and we use the 'static' evaluation
;; again (typically, this will be plus or minus *INFINITE* or zero).
((NULL (SETQ MOVES (GENERATE-MOVES HISTORY))) (EVALUATE HISTORY))
;; If none of the things above was true, we really have to think,
;; i.e. for all the possible moves, do the move and use this function
;; recursively with depth one less and alfa and beta reversed and
;; switched, thereby implementing alfa-beta-cut-offs.
(T (DOLIST (MOVE MOVES ALFA)
(SETQ VALUE (- (ANALYZE (1- DEPTH) (- BETA) (- ALFA)
(CONS (MAKE-MOVE MOVE (CAR HISTORY))
HISTORY))))
;; Now check if the value returned is greater than alfa.
(AND (> VALUE ALFA)
;; If so, and it is greater or equal than beta we can
;; skip the rest of the moves.
(>= (SETQ ALFA VALUE) BETA)
(RETURN ALFA))))))
;;; Function THINK does all the difficult stuff in this program. It is called
;;; when this program has to figure out its move or when the user wants some
;;; advise for his move (i.e. when gave the "hint"-command). This function
;;; will not be called when there is just one possible move.
(DEFUN THINK (&AUX VALUE ALARM ALFA QUIET)
;; First, lets hope for some help by the theory. If the current situation
;; exists in the theory, just return what the theory suggests.
(COND ((SETQ VALUE (ASSOC BOARD THEORY :TEST #'EQUAL)) (CDR VALUE))
;; Second, compute the time we've left to figure out a move. This is
;; done by setting the local variable ALARM to a value that is not to
;; be exceeded by the wall-clock. So in the sequel we can simply check
;; for (CLOCK) being greater than ALARM (in which case we better hurry,
;; or ...?). In the next formula we take into account the number of
;; seconds per move (i.e. the value of TIME-OR-DEPTH-LIMIT). If this
;; value is negative - in which case depth is the only restriction -
;; the value of ALARM is not relevant and not used. We also use the
;; time consumed by our opponent (if that is more than he should with
;; respect to TIME-OR-DEPTH-LIMIT, we also can safely use some more
;; time). Finally, the amount of time is multiplied by a factor (L-1)/L
;; (where L is the number of possible moves in this sitation) in order
;; to anticipate possible combinatory explosions...
(T (SETQ ALARM
(+ START-TIME
(/ (* (1- (LENGTH LIST-OF-MOVES))
(IF (EQUAL (CURRENT-PLAYER BOARD) PLAYER1)
(- (MAX (* MOVE-COUNTER TIME-OR-DEPTH-LIMIT)
PLAYER2-TIME)
PLAYER1-TIME)
(- (MAX (* MOVE-COUNTER TIME-OR-DEPTH-LIMIT)
PLAYER1-TIME)
PLAYER2-TIME)))
(LENGTH LIST-OF-MOVES))))
;; The outer loop implements progressive deepening and feed-over's.
;; It 'endlessly' increments the depth and sets the local variable
;; QUIESCENCE to QUIET (initially NIL). QUIET is set in the innner
;; loop. Tests for leaving this outer loop are at its end.
(DO ((DEPTH 2 (1+ DEPTH)) (QUIESCENCE NIL QUIET)) ()
;; Setting BOTTOM-OF-TREE-P true and find it still to be true at the
;; end of the the loop (i.e. the function ANALYZE didn't set it to
;; NIL), means that we can leave this loop because we've reached the
;; end of the game.
(SETQ BOTTOM-OF-TREE-P T)
;; Start with alfa being minus infinite. Note that in this function
;; we use alfa-only-cut-offs because we stay at the top-level of the
;; search-tree.
(SETQ ALFA (- *INFINITE*))
;; Here is the inner loop which simply goes over all the moves. Note
;; that we can not use the DOLIST-construct here because the list is
;; reordered within this loop!
(DO* ((I 0 (1+ I)) (MOVE (CAR LIST-OF-MOVES) (NTH I LIST-OF-MOVES)))
;; We can exit from this loop when there are no more moves (yes,
;; now we have to check that explicitly) or when alfa has reached
;; infinity (which means we have won!)
((OR (NULL MOVE) (= ALFA *INFINITE*)))
;; First check if we've run out of time and the situation is
;; quiet. If so, clobber the value of DEPTH to make the outer
;; loop believe he has to return also.
(COND ((AND (>= TIME-OR-DEPTH-LIMIT 0)
(> (CLOCK) ALARM)
QUIESCENCE)
(SETQ DEPTH (- TIME-OR-DEPTH-LIMIT))
(RETURN)))
;; If time left or 'condition red', let ANALYZE do its work. Note
;; that beta is always inifinite here at the top-level.
(SETQ VALUE (- (ANALYZE (1- DEPTH) (- *INFINITE*) (- ALFA)
(CONS (MAKE-MOVE MOVE BOARD) HISTORY))))
;; If the user wants to see the evaluations, show him now.
;; Note that, due to alfa-beta-cut-offs, less valuable moves
;; are shown with value 'not less' (i.e. equal to) than the
;; value of the best move so far.
(COND (SHOW-EVALUATIONS-P
(COND ((ZEROP I) (TERPRI)
(PRINC "Depth=") (PRINC DEPTH)))
(PRINC " ") (PRINC MOVE)
(PRINC "=") (PRINC VALUE)))
;; If this move is better than the previous 'best' move, put
;; it in front of the list (and save this value in alfa for
;; future comparisons).
(COND ((> VALUE ALFA) (SETQ ALFA VALUE)
(SETQ LIST-OF-MOVES
(NCONC (LIST MOVE)
(DELETE MOVE LIST-OF-MOVES :TEST #'EQUAL)))
;; Ideally, the best move is in front of the list, so if
;; I equals zero (we were evaluating the first move) it
;; is normal to find a value greater than minus infinity.
;; However, if I is not zero, we've found a better move
;; that was not the first one in the list. This is an in-
;; dication that we are not in a quiet situation (so set
;; QUIET to NIL, which will be used in the outer loop).
(SETQ QUIET (= I 0)))))
;; This is the end of the inner loop.
;; Here are the tests for leaving the outer loop. There can be three
;; reasons for leaving. First, we've reached the end of the game
;; (which actually means that the function ANALYZE never got a depth-
;; value of zero). Second, the winner is known (which means that alfa
;; is plus or minus infinite). In these first two cases we can inform
;; the user what we found out by the function EPILOG but without
;; exiting the game. Third and last reason: we've simply reached the
;; depth-limit set by the user (with the "sets"-command). Note that
;; this last reason can never happen when he set TIME-OR-DEPTH-LIMIT
;; to -1 because this loops starts with DEPTH=2!!! However, the value
;; of DEPTH can be set to (- TIME-OR-DEPTH-LIMIT) by the inner-loop
;; in order to return when time forces us to do so.
(IF (OR (ZEROP (+ TIME-OR-DEPTH-LIMIT DEPTH))
(AND (OR BOTTOM-OF-TREE-P (= (ABS ALFA) *INFINITE*))
(EPILOG NIL ALFA)))
(RETURN (CAR LIST-OF-MOVES)))))))
;;; EPILOG is used to inform the user about the end of the game. It is used
;;; in the function THINK (in which the first argument is NIL, meaning: only
;;; inform, but do not exit the program). It is really used to exit the pro-
;;; gram (after giving the information) when there are no more moves generated
;;; in the main-function GAME.
(DEFUN EPILOG (FINISH &OPTIONAL VALUE)
;; First check if any evaluation is wanted.
(COND (VALUE
(TERPRI)
;; Second, check if we have to report the result and there is a winner.
(COND ((= VALUE *INFINITE*)
;; If so, we distinguish again between the 'personal' approach
;; and the formal (as we did in the function PRINT-SITUATION).
(COND ((EQUAL (CURRENT-PLAYER BOARD) COMPUTER-ROLE)
(PRINC "I win"))
(COMPUTER-ROLE (PRINC "You win"))
(T (PRINC (CURRENT-PLAYER BOARD)) (PRINC " wins"))))
;; If no winner, than maybe there is a looser.
((= VALUE (- *INFINITE*))
(COND ((EQUAL (CURRENT-PLAYER BOARD) COMPUTER-ROLE)
(PRINC "I loose"))
(COMPUTER-ROLE (PRINC "You loose"))
(T (PRINC (CURRENT-PLAYER BOARD)) (PRINC " looses"))))
;; If the evaluation is zero, then we drew.
((ZEROP VALUE) (PRINC "Draw"))
;; Finally, if none of the above is true, the game is undecided
;; but over anyway.
(T (PRINC "Game over")))
(PRINC "!") (TERPRI)))
;; Ask if theory has to be saved (when appropiate).
(DO (F) ((NOT (AND FINISH THEORY-UPDATED-P)))
(TERPRI)
(PRINC "Save the theory? (NIL if no, filename if yes) ")
(COND ((SETQ F (READ))
(COND ((SETF F (OPENO F))
(PPRINT THEORY F) (CLOSE F)
(SETQ THEORY-UPDATED-P NIL))
(T (PRINC "Can't open output-file"))))
(T (SETQ THEORY-UPDATED-P NIL))))
(IF FINISH (EXIT) T))
;;; Now you've read all this, let's do it!
(GAME)
;;; Things to be done:
;;; ------------------
;;; More sophisticated handling of theory (hashing BOARD into database).
;;; Use opponent's time to set up search-tree and start evaluations.
;;; Create validation-suite (or reproducible covering test-set).
;;; Modification history
;;; --------------------
;;;
;;; april 1987, initial version 1.0
;;;
;;; may 1987, removed "learn"-option in which every move was added
;;; to the theory (as with most 'learning' systems, you don't
;;; have control over whatever is learned and it finally kills
;;; your application because it suffers from all 'knowledge'
;;; it has to carry). To build a good theory, you have to use
;;; the "tell"-command selectivily.
;;; Added "auto"-command to toggle between automatically move
;;; (or not) when there is only 1 move.
;;; Changed the function INFORMATION accordingly.
;;; Made this version 1.1.