Power-Programmierung

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 | 42.7 KB | 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.