diff options
| author | Jari Aalto | 2011-01-22 15:12:51 -0500 |
|---|---|---|
| committer | Chong Yidong | 2011-01-22 15:12:51 -0500 |
| commit | 4d0143e6d7252cf83d44be1f4b604d73b8d61670 (patch) | |
| tree | 591a095eaef81da7a1ccd7b6bd51bdfc1bf01f89 | |
| parent | 4474c927a7f8c8c53b2027d17357adf5613ae1bf (diff) | |
| download | emacs-4d0143e6d7252cf83d44be1f4b604d73b8d61670.tar.gz emacs-4d0143e6d7252cf83d44be1f4b604d73b8d61670.zip | |
* play/landmark.el: Change `lm-' prefix to `landmark-' (Bug#7672).
(lm): Rename to landmark.
(lm-test-run): Rename to landmark-test-run.
| -rw-r--r-- | etc/NEWS | 2 | ||||
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/play/landmark.el | 1348 |
3 files changed, 677 insertions, 679 deletions
| @@ -327,6 +327,8 @@ prompts for a number to count from and for a format string. | |||
| 327 | 327 | ||
| 328 | * Changes in Specialized Modes and Packages in Emacs 24.1 | 328 | * Changes in Specialized Modes and Packages in Emacs 24.1 |
| 329 | 329 | ||
| 330 | ** The Landmark game is now invoked with `landmark', not `lm'. | ||
| 331 | |||
| 330 | ** Prolog mode has been completely revamped, with lots of additional | 332 | ** Prolog mode has been completely revamped, with lots of additional |
| 331 | functionality such as more intelligent indentation, electricty, support for | 333 | functionality such as more intelligent indentation, electricty, support for |
| 332 | more variants, including Mercury, and a lot more. | 334 | more variants, including Mercury, and a lot more. |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1106f4b7178..ab6c5c8ee63 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2011-01-22 Jari Aalto <jari.aalto@cante.net> | ||
| 2 | |||
| 3 | * play/landmark.el: Change `lm-' prefix to `landmark-' (Bug#7672). | ||
| 4 | (lm): Rename to landmark. | ||
| 5 | (lm-test-run): Rename to landmark-test-run. | ||
| 6 | |||
| 1 | 2011-01-22 Chong Yidong <cyd@stupidchicken.com> | 7 | 2011-01-22 Chong Yidong <cyd@stupidchicken.com> |
| 2 | 8 | ||
| 3 | * emacs-lisp/re-builder.el (reb-mode-map): Fix logic error in | 9 | * emacs-lisp/re-builder.el (reb-mode-map): Fix logic error in |
diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index b3a85a66362..6701774ef0a 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el | |||
| @@ -10,7 +10,7 @@ | |||
| 10 | ;;;_* Usage | 10 | ;;;_* Usage |
| 11 | ;;; Just type | 11 | ;;; Just type |
| 12 | ;;; M-x eval-buffer | 12 | ;;; M-x eval-buffer |
| 13 | ;;; M-x lm-test-run | 13 | ;;; M-x landmark-test-run |
| 14 | 14 | ||
| 15 | 15 | ||
| 16 | ;; This file is part of GNU Emacs. | 16 | ;; This file is part of GNU Emacs. |
| @@ -30,7 +30,7 @@ | |||
| 30 | 30 | ||
| 31 | 31 | ||
| 32 | ;;; Commentary: | 32 | ;;; Commentary: |
| 33 | ;; Lm is a relatively non-participatory game in which a robot | 33 | ;; Landmark is a relatively non-participatory game in which a robot |
| 34 | ;; attempts to maneuver towards a tree at the center of the window | 34 | ;; attempts to maneuver towards a tree at the center of the window |
| 35 | ;; based on unique olfactory cues from each of the 4 directions. If | 35 | ;; based on unique olfactory cues from each of the 4 directions. If |
| 36 | ;; the smell of the tree increases, then the weights in the robot's | 36 | ;; the smell of the tree increases, then the weights in the robot's |
| @@ -53,7 +53,7 @@ | |||
| 53 | ;; a single move, one moves east,west and south, then both east and | 53 | ;; a single move, one moves east,west and south, then both east and |
| 54 | ;; west will be improved when they shouldn't | 54 | ;; west will be improved when they shouldn't |
| 55 | 55 | ||
| 56 | ;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this | 56 | ;; Many thanks to Yuri Pryadkin <yuri@rana.usc.edu> for this |
| 57 | ;; concise problem description. | 57 | ;; concise problem description. |
| 58 | 58 | ||
| 59 | ;;;_* Require | 59 | ;;;_* Require |
| @@ -63,9 +63,9 @@ | |||
| 63 | 63 | ||
| 64 | ;;; Code: | 64 | ;;; Code: |
| 65 | 65 | ||
| 66 | (defgroup lm nil | 66 | (defgroup landmark nil |
| 67 | "Neural-network robot that learns landmarks." | 67 | "Neural-network robot that learns landmarks." |
| 68 | :prefix "lm-" | 68 | :prefix "landmark-" |
| 69 | :group 'games) | 69 | :group 'games) |
| 70 | 70 | ||
| 71 | ;;;_ + THE BOARD. | 71 | ;;;_ + THE BOARD. |
| @@ -75,199 +75,199 @@ | |||
| 75 | ;; containing padding squares (coded with -1). These squares allow us to | 75 | ;; containing padding squares (coded with -1). These squares allow us to |
| 76 | ;; detect when we are trying to move out of the board. We denote a square by | 76 | ;; detect when we are trying to move out of the board. We denote a square by |
| 77 | ;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The | 77 | ;; its (X,Y) coords, or by the INDEX corresponding to them in the vector. The |
| 78 | ;; leftmost topmost square has coords (1,1) and index lm-board-width + 2. | 78 | ;; leftmost topmost square has coords (1,1) and index landmark-board-width + 2. |
| 79 | ;; Similarly, vectors between squares may be given by two DX, DY coords or by | 79 | ;; Similarly, vectors between squares may be given by two DX, DY coords or by |
| 80 | ;; one DEPL (the difference between indexes). | 80 | ;; one DEPL (the difference between indexes). |
| 81 | 81 | ||
| 82 | (defvar lm-board-width nil | 82 | (defvar landmark-board-width nil |
| 83 | "Number of columns on the Lm board.") | 83 | "Number of columns on the Landmark board.") |
| 84 | (defvar lm-board-height nil | 84 | (defvar landmark-board-height nil |
| 85 | "Number of lines on the Lm board.") | 85 | "Number of lines on the Landmark board.") |
| 86 | 86 | ||
| 87 | (defvar lm-board nil | 87 | (defvar landmark-board nil |
| 88 | "Vector recording the actual state of the Lm board.") | 88 | "Vector recording the actual state of the Landmark board.") |
| 89 | 89 | ||
| 90 | (defvar lm-vector-length nil | 90 | (defvar landmark-vector-length nil |
| 91 | "Length of lm-board vector.") | 91 | "Length of landmark-board vector.") |
| 92 | 92 | ||
| 93 | (defvar lm-draw-limit nil | 93 | (defvar landmark-draw-limit nil |
| 94 | ;; This is usually set to 70% of the number of squares. | 94 | ;; This is usually set to 70% of the number of squares. |
| 95 | "After how many moves will Emacs offer a draw?") | 95 | "After how many moves will Emacs offer a draw?") |
| 96 | 96 | ||
| 97 | (defvar lm-cx 0 | 97 | (defvar landmark-cx 0 |
| 98 | "This is the x coordinate of the center of the board.") | 98 | "This is the x coordinate of the center of the board.") |
| 99 | 99 | ||
| 100 | (defvar lm-cy 0 | 100 | (defvar landmark-cy 0 |
| 101 | "This is the y coordinate of the center of the board.") | 101 | "This is the y coordinate of the center of the board.") |
| 102 | 102 | ||
| 103 | (defvar lm-m 0 | 103 | (defvar landmark-m 0 |
| 104 | "This is the x dimension of the playing board.") | 104 | "This is the x dimension of the playing board.") |
| 105 | 105 | ||
| 106 | (defvar lm-n 0 | 106 | (defvar landmark-n 0 |
| 107 | "This is the y dimension of the playing board.") | 107 | "This is the y dimension of the playing board.") |
| 108 | 108 | ||
| 109 | 109 | ||
| 110 | (defun lm-xy-to-index (x y) | 110 | (defun landmark-xy-to-index (x y) |
| 111 | "Translate X, Y cartesian coords into the corresponding board index." | 111 | "Translate X, Y cartesian coords into the corresponding board index." |
| 112 | (+ (* y lm-board-width) x y)) | 112 | (+ (* y landmark-board-width) x y)) |
| 113 | 113 | ||
| 114 | (defun lm-index-to-x (index) | 114 | (defun landmark-index-to-x (index) |
| 115 | "Return corresponding x-coord of board INDEX." | 115 | "Return corresponding x-coord of board INDEX." |
| 116 | (% index (1+ lm-board-width))) | 116 | (% index (1+ landmark-board-width))) |
| 117 | 117 | ||
| 118 | (defun lm-index-to-y (index) | 118 | (defun landmark-index-to-y (index) |
| 119 | "Return corresponding y-coord of board INDEX." | 119 | "Return corresponding y-coord of board INDEX." |
| 120 | (/ index (1+ lm-board-width))) | 120 | (/ index (1+ landmark-board-width))) |
| 121 | 121 | ||
| 122 | (defun lm-init-board () | 122 | (defun landmark-init-board () |
| 123 | "Create the lm-board vector and fill it with initial values." | 123 | "Create the landmark-board vector and fill it with initial values." |
| 124 | (setq lm-board (make-vector lm-vector-length 0)) | 124 | (setq landmark-board (make-vector landmark-vector-length 0)) |
| 125 | ;; Every square is 0 (i.e. empty) except padding squares: | 125 | ;; Every square is 0 (i.e. empty) except padding squares: |
| 126 | (let ((i 0) (ii (1- lm-vector-length))) | 126 | (let ((i 0) (ii (1- landmark-vector-length))) |
| 127 | (while (<= i lm-board-width) ; The squares in [0..width] and in | 127 | (while (<= i landmark-board-width) ; The squares in [0..width] and in |
| 128 | (aset lm-board i -1) ; [length - width - 1..length - 1] | 128 | (aset landmark-board i -1) ; [length - width - 1..length - 1] |
| 129 | (aset lm-board ii -1) ; are padding squares. | 129 | (aset landmark-board ii -1) ; are padding squares. |
| 130 | (setq i (1+ i) | 130 | (setq i (1+ i) |
| 131 | ii (1- ii)))) | 131 | ii (1- ii)))) |
| 132 | (let ((i 0)) | 132 | (let ((i 0)) |
| 133 | (while (< i lm-vector-length) | 133 | (while (< i landmark-vector-length) |
| 134 | (aset lm-board i -1) ; and also all k*(width+1) | 134 | (aset landmark-board i -1) ; and also all k*(width+1) |
| 135 | (setq i (+ i lm-board-width 1))))) | 135 | (setq i (+ i landmark-board-width 1))))) |
| 136 | 136 | ||
| 137 | ;;;_ + DISPLAYING THE BOARD. | 137 | ;;;_ + DISPLAYING THE BOARD. |
| 138 | 138 | ||
| 139 | ;; You may change these values if you have a small screen or if the squares | 139 | ;; You may change these values if you have a small screen or if the squares |
| 140 | ;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). | 140 | ;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). |
| 141 | 141 | ||
| 142 | (defconst lm-square-width 2 | 142 | (defconst landmark-square-width 2 |
| 143 | "*Horizontal spacing between squares on the Lm board.") | 143 | "*Horizontal spacing between squares on the Landmark board.") |
| 144 | 144 | ||
| 145 | (defconst lm-square-height 1 | 145 | (defconst landmark-square-height 1 |
| 146 | "*Vertical spacing between squares on the Lm board.") | 146 | "*Vertical spacing between squares on the Landmark board.") |
| 147 | 147 | ||
| 148 | (defconst lm-x-offset 3 | 148 | (defconst landmark-x-offset 3 |
| 149 | "*Number of columns between the Lm board and the side of the window.") | 149 | "*Number of columns between the Landmark board and the side of the window.") |
| 150 | 150 | ||
| 151 | (defconst lm-y-offset 1 | 151 | (defconst landmark-y-offset 1 |
| 152 | "*Number of lines between the Lm board and the top of the window.") | 152 | "*Number of lines between the Landmark board and the top of the window.") |
| 153 | 153 | ||
| 154 | 154 | ||
| 155 | ;;;_ + LM MODE AND KEYMAP. | 155 | ;;;_ + LANDMARK MODE AND KEYMAP. |
| 156 | 156 | ||
| 157 | (defcustom lm-mode-hook nil | 157 | (defcustom landmark-mode-hook nil |
| 158 | "If non-nil, its value is called on entry to Lm mode." | 158 | "If non-nil, its value is called on entry to Landmark mode." |
| 159 | :type 'hook | 159 | :type 'hook |
| 160 | :group 'lm) | 160 | :group 'landmark) |
| 161 | 161 | ||
| 162 | (defvar lm-mode-map | 162 | (defvar landmark-mode-map |
| 163 | (let ((map (make-sparse-keymap))) | 163 | (let ((map (make-sparse-keymap))) |
| 164 | ;; Key bindings for cursor motion. | 164 | ;; Key bindings for cursor motion. |
| 165 | (define-key map "y" 'lm-move-nw) ; y | 165 | (define-key map "y" 'landmark-move-nw) ; y |
| 166 | (define-key map "u" 'lm-move-ne) ; u | 166 | (define-key map "u" 'landmark-move-ne) ; u |
| 167 | (define-key map "b" 'lm-move-sw) ; b | 167 | (define-key map "b" 'landmark-move-sw) ; b |
| 168 | (define-key map "n" 'lm-move-se) ; n | 168 | (define-key map "n" 'landmark-move-se) ; n |
| 169 | (define-key map "h" 'backward-char) ; h | 169 | (define-key map "h" 'backward-char) ; h |
| 170 | (define-key map "l" 'forward-char) ; l | 170 | (define-key map "l" 'forward-char) ; l |
| 171 | (define-key map "j" 'lm-move-down) ; j | 171 | (define-key map "j" 'landmark-move-down) ; j |
| 172 | (define-key map "k" 'lm-move-up) ; k | 172 | (define-key map "k" 'landmark-move-up) ; k |
| 173 | 173 | ||
| 174 | (define-key map [kp-7] 'lm-move-nw) | 174 | (define-key map [kp-7] 'landmark-move-nw) |
| 175 | (define-key map [kp-9] 'lm-move-ne) | 175 | (define-key map [kp-9] 'landmark-move-ne) |
| 176 | (define-key map [kp-1] 'lm-move-sw) | 176 | (define-key map [kp-1] 'landmark-move-sw) |
| 177 | (define-key map [kp-3] 'lm-move-se) | 177 | (define-key map [kp-3] 'landmark-move-se) |
| 178 | (define-key map [kp-4] 'backward-char) | 178 | (define-key map [kp-4] 'backward-char) |
| 179 | (define-key map [kp-6] 'forward-char) | 179 | (define-key map [kp-6] 'forward-char) |
| 180 | (define-key map [kp-2] 'lm-move-down) | 180 | (define-key map [kp-2] 'landmark-move-down) |
| 181 | (define-key map [kp-8] 'lm-move-up) | 181 | (define-key map [kp-8] 'landmark-move-up) |
| 182 | 182 | ||
| 183 | (define-key map "\C-n" 'lm-move-down) ; C-n | 183 | (define-key map "\C-n" 'landmark-move-down) ; C-n |
| 184 | (define-key map "\C-p" 'lm-move-up) ; C-p | 184 | (define-key map "\C-p" 'landmark-move-up) ; C-p |
| 185 | 185 | ||
| 186 | ;; Key bindings for entering Human moves. | 186 | ;; Key bindings for entering Human moves. |
| 187 | (define-key map "X" 'lm-human-plays) ; X | 187 | (define-key map "X" 'landmark-human-plays) ; X |
| 188 | (define-key map "x" 'lm-human-plays) ; x | 188 | (define-key map "x" 'landmark-human-plays) ; x |
| 189 | 189 | ||
| 190 | (define-key map " " 'lm-start-robot) ; SPC | 190 | (define-key map " " 'landmark-start-robot) ; SPC |
| 191 | (define-key map [down-mouse-1] 'lm-start-robot) | 191 | (define-key map [down-mouse-1] 'landmark-start-robot) |
| 192 | (define-key map [drag-mouse-1] 'lm-click) | 192 | (define-key map [drag-mouse-1] 'landmark-click) |
| 193 | (define-key map [mouse-1] 'lm-click) | 193 | (define-key map [mouse-1] 'landmark-click) |
| 194 | (define-key map [down-mouse-2] 'lm-click) | 194 | (define-key map [down-mouse-2] 'landmark-click) |
| 195 | (define-key map [mouse-2] 'lm-mouse-play) | 195 | (define-key map [mouse-2] 'landmark-mouse-play) |
| 196 | (define-key map [drag-mouse-2] 'lm-mouse-play) | 196 | (define-key map [drag-mouse-2] 'landmark-mouse-play) |
| 197 | 197 | ||
| 198 | (define-key map [remap previous-line] 'lm-move-up) | 198 | (define-key map [remap previous-line] 'landmark-move-up) |
| 199 | (define-key map [remap next-line] 'lm-move-down) | 199 | (define-key map [remap next-line] 'landmark-move-down) |
| 200 | (define-key map [remap beginning-of-line] 'lm-beginning-of-line) | 200 | (define-key map [remap beginning-of-line] 'landmark-beginning-of-line) |
| 201 | (define-key map [remap end-of-line] 'lm-end-of-line) | 201 | (define-key map [remap end-of-line] 'landmark-end-of-line) |
| 202 | (define-key map [remap undo] 'lm-human-takes-back) | 202 | (define-key map [remap undo] 'landmark-human-takes-back) |
| 203 | (define-key map [remap advertised-undo] 'lm-human-takes-back) | 203 | (define-key map [remap advertised-undo] 'landmark-human-takes-back) |
| 204 | map) | 204 | map) |
| 205 | "Local keymap to use in Lm mode.") | 205 | "Local keymap to use in Landmark mode.") |
| 206 | 206 | ||
| 207 | 207 | ||
| 208 | 208 | ||
| 209 | (defvar lm-emacs-won () | 209 | (defvar landmark-emacs-won () |
| 210 | "*For making font-lock use the winner's face for the line.") | 210 | "*For making font-lock use the winner's face for the line.") |
| 211 | 211 | ||
| 212 | (defface lm-font-lock-face-O '((((class color)) :foreground "red") | 212 | (defface landmark-font-lock-face-O '((((class color)) :foreground "red") |
| 213 | (t :weight bold)) | 213 | (t :weight bold)) |
| 214 | "Face to use for Emacs' O." | 214 | "Face to use for Emacs' O." |
| 215 | :version "22.1" | 215 | :version "22.1" |
| 216 | :group 'lm) | 216 | :group 'landmark) |
| 217 | 217 | ||
| 218 | (defface lm-font-lock-face-X '((((class color)) :foreground "green") | 218 | (defface landmark-font-lock-face-X '((((class color)) :foreground "green") |
| 219 | (t :weight bold)) | 219 | (t :weight bold)) |
| 220 | "Face to use for your X." | 220 | "Face to use for your X." |
| 221 | :version "22.1" | 221 | :version "22.1" |
| 222 | :group 'lm) | 222 | :group 'landmark) |
| 223 | 223 | ||
| 224 | (defvar lm-font-lock-keywords | 224 | (defvar landmark-font-lock-keywords |
| 225 | '(("O" . 'lm-font-lock-face-O) | 225 | '(("O" . 'landmark-font-lock-face-O) |
| 226 | ("X" . 'lm-font-lock-face-X) | 226 | ("X" . 'landmark-font-lock-face-X) |
| 227 | ("[-|/\\]" 0 (if lm-emacs-won | 227 | ("[-|/\\]" 0 (if landmark-emacs-won |
| 228 | 'lm-font-lock-face-O | 228 | 'landmark-font-lock-face-O |
| 229 | 'lm-font-lock-face-X))) | 229 | 'landmark-font-lock-face-X))) |
| 230 | "*Font lock rules for Lm.") | 230 | "*Font lock rules for Landmark.") |
| 231 | 231 | ||
| 232 | (put 'lm-mode 'front-sticky | 232 | (put 'landmark-mode 'front-sticky |
| 233 | (put 'lm-mode 'rear-nonsticky '(intangible))) | 233 | (put 'landmark-mode 'rear-nonsticky '(intangible))) |
| 234 | (put 'lm-mode 'intangible 1) | 234 | (put 'landmark-mode 'intangible 1) |
| 235 | ;; This one is for when they set view-read-only to t: Landmark cannot | 235 | ;; This one is for when they set view-read-only to t: Landmark cannot |
| 236 | ;; allow View Mode to be activated in its buffer. | 236 | ;; allow View Mode to be activated in its buffer. |
| 237 | (put 'lm-mode 'mode-class 'special) | 237 | (put 'landmark-mode 'mode-class 'special) |
| 238 | 238 | ||
| 239 | (defun lm-mode () | 239 | (defun landmark-mode () |
| 240 | "Major mode for playing Lm against Emacs. | 240 | "Major mode for playing Landmark against Emacs. |
| 241 | You and Emacs play in turn by marking a free square. You mark it with X | 241 | You and Emacs play in turn by marking a free square. You mark it with X |
| 242 | and Emacs marks it with O. The winner is the first to get five contiguous | 242 | and Emacs marks it with O. The winner is the first to get five contiguous |
| 243 | marks horizontally, vertically or in diagonal. | 243 | marks horizontally, vertically or in diagonal. |
| 244 | 244 | ||
| 245 | You play by moving the cursor over the square you choose and hitting \\[lm-human-plays]. | 245 | You play by moving the cursor over the square you choose and hitting \\[landmark-human-plays]. |
| 246 | 246 | ||
| 247 | Other useful commands: | 247 | Other useful commands: |
| 248 | \\{lm-mode-map} | 248 | \\{landmark-mode-map} |
| 249 | Entry to this mode calls the value of `lm-mode-hook' if that value | 249 | Entry to this mode calls the value of `landmark-mode-hook' if that value |
| 250 | is non-nil. One interesting value is `turn-on-font-lock'." | 250 | is non-nil. One interesting value is `turn-on-font-lock'." |
| 251 | (interactive) | 251 | (interactive) |
| 252 | (kill-all-local-variables) | 252 | (kill-all-local-variables) |
| 253 | (setq major-mode 'lm-mode | 253 | (setq major-mode 'landmark-mode |
| 254 | mode-name "Lm") | 254 | mode-name "Landmark") |
| 255 | (lm-display-statistics) | 255 | (landmark-display-statistics) |
| 256 | (use-local-map lm-mode-map) | 256 | (use-local-map landmark-mode-map) |
| 257 | (make-local-variable 'font-lock-defaults) | 257 | (make-local-variable 'font-lock-defaults) |
| 258 | (setq font-lock-defaults '(lm-font-lock-keywords t) | 258 | (setq font-lock-defaults '(landmark-font-lock-keywords t) |
| 259 | buffer-read-only t) | 259 | buffer-read-only t) |
| 260 | (run-mode-hooks 'lm-mode-hook)) | 260 | (run-mode-hooks 'landmark-mode-hook)) |
| 261 | 261 | ||
| 262 | 262 | ||
| 263 | ;;;_ + THE SCORE TABLE. | 263 | ;;;_ + THE SCORE TABLE. |
| 264 | 264 | ||
| 265 | 265 | ||
| 266 | ;; Every (free) square has a score associated to it, recorded in the | 266 | ;; Every (free) square has a score associated to it, recorded in the |
| 267 | ;; LM-SCORE-TABLE vector. The program always plays in the square having | 267 | ;; LANDMARK-SCORE-TABLE vector. The program always plays in the square having |
| 268 | ;; the highest score. | 268 | ;; the highest score. |
| 269 | 269 | ||
| 270 | (defvar lm-score-table nil | 270 | (defvar landmark-score-table nil |
| 271 | "Vector recording the actual score of the free squares.") | 271 | "Vector recording the actual score of the free squares.") |
| 272 | 272 | ||
| 273 | 273 | ||
| @@ -294,7 +294,7 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 294 | ;; the qtuples. | 294 | ;; the qtuples. |
| 295 | ;; | 295 | ;; |
| 296 | ;; This algorithm is rather simple but anyway it gives a not so dumb level of | 296 | ;; This algorithm is rather simple but anyway it gives a not so dumb level of |
| 297 | ;; play. It easily extends to "n-dimensional Lm", where a win should not | 297 | ;; play. It easily extends to "n-dimensional Landmark", where a win should not |
| 298 | ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) | 298 | ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) |
| 299 | ;; should be preferred. | 299 | ;; should be preferred. |
| 300 | 300 | ||
| @@ -303,9 +303,9 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 303 | ;; these values will change (hopefully improve) the strength of the program | 303 | ;; these values will change (hopefully improve) the strength of the program |
| 304 | ;; and may change its style (rather aggressive here). | 304 | ;; and may change its style (rather aggressive here). |
| 305 | 305 | ||
| 306 | (defconst lm-nil-score 7 "Score of an empty qtuple.") | 306 | (defconst landmark-nil-score 7 "Score of an empty qtuple.") |
| 307 | 307 | ||
| 308 | (defconst lm-score-trans-table | 308 | (defconst landmark-score-trans-table |
| 309 | (let ((Xscore 15) ; Score of a qtuple containing one X. | 309 | (let ((Xscore 15) ; Score of a qtuple containing one X. |
| 310 | (XXscore 400) ; Score of a qtuple containing two X's. | 310 | (XXscore 400) ; Score of a qtuple containing two X's. |
| 311 | (XXXscore 1800) ; Score of a qtuple containing three X's. | 311 | (XXXscore 1800) ; Score of a qtuple containing three X's. |
| @@ -338,7 +338,7 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 338 | ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, | 338 | ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, |
| 339 | ;; the contents of a qtuple are uniquely determined by the sum of | 339 | ;; the contents of a qtuple are uniquely determined by the sum of |
| 340 | ;; its elements and we just have to set up a translation table. | 340 | ;; its elements and we just have to set up a translation table. |
| 341 | (vector lm-nil-score Xscore XXscore XXXscore XXXXscore 0 | 341 | (vector landmark-nil-score Xscore XXscore XXXscore XXXXscore 0 |
| 342 | Oscore 0 0 0 0 0 | 342 | Oscore 0 0 0 0 0 |
| 343 | OOscore 0 0 0 0 0 | 343 | OOscore 0 0 0 0 0 |
| 344 | OOOscore 0 0 0 0 0 | 344 | OOOscore 0 0 0 0 0 |
| @@ -354,16 +354,16 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 354 | ;; qtuple. We may use these considerations to detect when a given move is | 354 | ;; qtuple. We may use these considerations to detect when a given move is |
| 355 | ;; winning or losing. | 355 | ;; winning or losing. |
| 356 | 356 | ||
| 357 | (defconst lm-winning-threshold | 357 | (defconst landmark-winning-threshold |
| 358 | (aref lm-score-trans-table (+ 6 6 6 6)) ;; OOOOscore | 358 | (aref landmark-score-trans-table (+ 6 6 6 6)) ;; OOOOscore |
| 359 | "Threshold score beyond which an Emacs move is winning.") | 359 | "Threshold score beyond which an Emacs move is winning.") |
| 360 | 360 | ||
| 361 | (defconst lm-losing-threshold | 361 | (defconst landmark-losing-threshold |
| 362 | (aref lm-score-trans-table (+ 1 1 1 1)) ;; XXXXscore | 362 | (aref landmark-score-trans-table (+ 1 1 1 1)) ;; XXXXscore |
| 363 | "Threshold score beyond which a human move is winning.") | 363 | "Threshold score beyond which a human move is winning.") |
| 364 | 364 | ||
| 365 | 365 | ||
| 366 | (defun lm-strongest-square () | 366 | (defun landmark-strongest-square () |
| 367 | "Compute index of free square with highest score, or nil if none." | 367 | "Compute index of free square with highest score, or nil if none." |
| 368 | ;; We just have to loop other all squares. However there are two problems: | 368 | ;; We just have to loop other all squares. However there are two problems: |
| 369 | ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed | 369 | ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed |
| @@ -372,23 +372,23 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 372 | ;; 2/ We want to choose randomly between equally good moves. | 372 | ;; 2/ We want to choose randomly between equally good moves. |
| 373 | (let ((score-max 0) | 373 | (let ((score-max 0) |
| 374 | (count 0) ; Number of equally good moves | 374 | (count 0) ; Number of equally good moves |
| 375 | (square (lm-xy-to-index 1 1)) ; First square | 375 | (square (landmark-xy-to-index 1 1)) ; First square |
| 376 | (end (lm-xy-to-index lm-board-width lm-board-height)) | 376 | (end (landmark-xy-to-index landmark-board-width landmark-board-height)) |
| 377 | best-square score) | 377 | best-square score) |
| 378 | (while (<= square end) | 378 | (while (<= square end) |
| 379 | (cond | 379 | (cond |
| 380 | ;; If score is lower (i.e. most of the time), skip to next: | 380 | ;; If score is lower (i.e. most of the time), skip to next: |
| 381 | ((< (aref lm-score-table square) score-max)) | 381 | ((< (aref landmark-score-table square) score-max)) |
| 382 | ;; If score is better, beware of non free squares: | 382 | ;; If score is better, beware of non free squares: |
| 383 | ((> (setq score (aref lm-score-table square)) score-max) | 383 | ((> (setq score (aref landmark-score-table square)) score-max) |
| 384 | (if (zerop (aref lm-board square)) ; is it free ? | 384 | (if (zerop (aref landmark-board square)) ; is it free ? |
| 385 | (setq count 1 ; yes: take it ! | 385 | (setq count 1 ; yes: take it ! |
| 386 | best-square square | 386 | best-square square |
| 387 | score-max score) | 387 | score-max score) |
| 388 | (aset lm-score-table square -1))) ; no: kill it ! | 388 | (aset landmark-score-table square -1))) ; no: kill it ! |
| 389 | ;; If score is equally good, choose randomly. But first check freeness: | 389 | ;; If score is equally good, choose randomly. But first check freeness: |
| 390 | ((not (zerop (aref lm-board square))) | 390 | ((not (zerop (aref landmark-board square))) |
| 391 | (aset lm-score-table square -1)) | 391 | (aset landmark-score-table square -1)) |
| 392 | ((zerop (random (setq count (1+ count)))) | 392 | ((zerop (random (setq count (1+ count)))) |
| 393 | (setq best-square square | 393 | (setq best-square square |
| 394 | score-max score))) | 394 | score-max score))) |
| @@ -407,28 +407,28 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 407 | ;; Also, as it is likely that successive games will be played on a board with | 407 | ;; Also, as it is likely that successive games will be played on a board with |
| 408 | ;; same size, it is a good idea to save the initial SCORE-TABLE configuration. | 408 | ;; same size, it is a good idea to save the initial SCORE-TABLE configuration. |
| 409 | 409 | ||
| 410 | (defvar lm-saved-score-table nil | 410 | (defvar landmark-saved-score-table nil |
| 411 | "Recorded initial value of previous score table.") | 411 | "Recorded initial value of previous score table.") |
| 412 | 412 | ||
| 413 | (defvar lm-saved-board-width nil | 413 | (defvar landmark-saved-board-width nil |
| 414 | "Recorded value of previous board width.") | 414 | "Recorded value of previous board width.") |
| 415 | 415 | ||
| 416 | (defvar lm-saved-board-height nil | 416 | (defvar landmark-saved-board-height nil |
| 417 | "Recorded value of previous board height.") | 417 | "Recorded value of previous board height.") |
| 418 | 418 | ||
| 419 | 419 | ||
| 420 | (defun lm-init-score-table () | 420 | (defun landmark-init-score-table () |
| 421 | "Create the score table vector and fill it with initial values." | 421 | "Create the score table vector and fill it with initial values." |
| 422 | (if (and lm-saved-score-table ; Has it been stored last time ? | 422 | (if (and landmark-saved-score-table ; Has it been stored last time ? |
| 423 | (= lm-board-width lm-saved-board-width) | 423 | (= landmark-board-width landmark-saved-board-width) |
| 424 | (= lm-board-height lm-saved-board-height)) | 424 | (= landmark-board-height landmark-saved-board-height)) |
| 425 | (setq lm-score-table (copy-sequence lm-saved-score-table)) | 425 | (setq landmark-score-table (copy-sequence landmark-saved-score-table)) |
| 426 | ;; No, compute it: | 426 | ;; No, compute it: |
| 427 | (setq lm-score-table | 427 | (setq landmark-score-table |
| 428 | (make-vector lm-vector-length (* 20 lm-nil-score))) | 428 | (make-vector landmark-vector-length (* 20 landmark-nil-score))) |
| 429 | (let (i j maxi maxj maxi2 maxj2) | 429 | (let (i j maxi maxj maxi2 maxj2) |
| 430 | (setq maxi (/ (1+ lm-board-width) 2) | 430 | (setq maxi (/ (1+ landmark-board-width) 2) |
| 431 | maxj (/ (1+ lm-board-height) 2) | 431 | maxj (/ (1+ landmark-board-height) 2) |
| 432 | maxi2 (min 4 maxi) | 432 | maxi2 (min 4 maxi) |
| 433 | maxj2 (min 4 maxj)) | 433 | maxj2 (min 4 maxj)) |
| 434 | ;; We took symmetry into account and could use it more if the board | 434 | ;; We took symmetry into account and could use it more if the board |
| @@ -440,43 +440,43 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 440 | (while (<= i maxi2) | 440 | (while (<= i maxi2) |
| 441 | (setq j 1) | 441 | (setq j 1) |
| 442 | (while (<= j maxj) | 442 | (while (<= j maxj) |
| 443 | (lm-init-square-score i j) | 443 | (landmark-init-square-score i j) |
| 444 | (setq j (1+ j))) | 444 | (setq j (1+ j))) |
| 445 | (setq i (1+ i))) | 445 | (setq i (1+ i))) |
| 446 | (while (<= i maxi) | 446 | (while (<= i maxi) |
| 447 | (setq j 1) | 447 | (setq j 1) |
| 448 | (while (<= j maxj2) | 448 | (while (<= j maxj2) |
| 449 | (lm-init-square-score i j) | 449 | (landmark-init-square-score i j) |
| 450 | (setq j (1+ j))) | 450 | (setq j (1+ j))) |
| 451 | (setq i (1+ i)))) | 451 | (setq i (1+ i)))) |
| 452 | (setq lm-saved-score-table (copy-sequence lm-score-table) | 452 | (setq landmark-saved-score-table (copy-sequence landmark-score-table) |
| 453 | lm-saved-board-width lm-board-width | 453 | landmark-saved-board-width landmark-board-width |
| 454 | lm-saved-board-height lm-board-height))) | 454 | landmark-saved-board-height landmark-board-height))) |
| 455 | 455 | ||
| 456 | (defun lm-nb-qtuples (i j) | 456 | (defun landmark-nb-qtuples (i j) |
| 457 | "Return the number of qtuples containing square I,J." | 457 | "Return the number of qtuples containing square I,J." |
| 458 | ;; This function is complicated because we have to deal | 458 | ;; This function is complicated because we have to deal |
| 459 | ;; with ugly cases like 3 by 6 boards, but it works. | 459 | ;; with ugly cases like 3 by 6 boards, but it works. |
| 460 | ;; If you have a simpler (and correct) solution, send it to me. Thanks ! | 460 | ;; If you have a simpler (and correct) solution, send it to me. Thanks ! |
| 461 | (let ((left (min 4 (1- i))) | 461 | (let ((left (min 4 (1- i))) |
| 462 | (right (min 4 (- lm-board-width i))) | 462 | (right (min 4 (- landmark-board-width i))) |
| 463 | (up (min 4 (1- j))) | 463 | (up (min 4 (1- j))) |
| 464 | (down (min 4 (- lm-board-height j)))) | 464 | (down (min 4 (- landmark-board-height j)))) |
| 465 | (+ -12 | 465 | (+ -12 |
| 466 | (min (max (+ left right) 3) 8) | 466 | (min (max (+ left right) 3) 8) |
| 467 | (min (max (+ up down) 3) 8) | 467 | (min (max (+ up down) 3) 8) |
| 468 | (min (max (+ (min left up) (min right down)) 3) 8) | 468 | (min (max (+ (min left up) (min right down)) 3) 8) |
| 469 | (min (max (+ (min right up) (min left down)) 3) 8)))) | 469 | (min (max (+ (min right up) (min left down)) 3) 8)))) |
| 470 | 470 | ||
| 471 | (defun lm-init-square-score (i j) | 471 | (defun landmark-init-square-score (i j) |
| 472 | "Give initial score to square I,J and to its mirror images." | 472 | "Give initial score to square I,J and to its mirror images." |
| 473 | (let ((ii (1+ (- lm-board-width i))) | 473 | (let ((ii (1+ (- landmark-board-width i))) |
| 474 | (jj (1+ (- lm-board-height j))) | 474 | (jj (1+ (- landmark-board-height j))) |
| 475 | (sc (* (lm-nb-qtuples i j) (aref lm-score-trans-table 0)))) | 475 | (sc (* (landmark-nb-qtuples i j) (aref landmark-score-trans-table 0)))) |
| 476 | (aset lm-score-table (lm-xy-to-index i j) sc) | 476 | (aset landmark-score-table (landmark-xy-to-index i j) sc) |
| 477 | (aset lm-score-table (lm-xy-to-index ii j) sc) | 477 | (aset landmark-score-table (landmark-xy-to-index ii j) sc) |
| 478 | (aset lm-score-table (lm-xy-to-index i jj) sc) | 478 | (aset landmark-score-table (landmark-xy-to-index i jj) sc) |
| 479 | (aset lm-score-table (lm-xy-to-index ii jj) sc))) | 479 | (aset landmark-score-table (landmark-xy-to-index ii jj) sc))) |
| 480 | ;;;_ - MAINTAINING THE SCORE TABLE. | 480 | ;;;_ - MAINTAINING THE SCORE TABLE. |
| 481 | 481 | ||
| 482 | 482 | ||
| @@ -486,7 +486,7 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 486 | ;; SCORE-TABLE after each move. Updating needs not modify more than 36 | 486 | ;; SCORE-TABLE after each move. Updating needs not modify more than 36 |
| 487 | ;; squares: it is done in constant time. | 487 | ;; squares: it is done in constant time. |
| 488 | 488 | ||
| 489 | (defun lm-update-score-table (square dval) | 489 | (defun landmark-update-score-table (square dval) |
| 490 | "Update score table after SQUARE received a DVAL increment." | 490 | "Update score table after SQUARE received a DVAL increment." |
| 491 | ;; The board has already been updated when this function is called. | 491 | ;; The board has already been updated when this function is called. |
| 492 | ;; Updating scores is done by looking for qtuples boundaries in all four | 492 | ;; Updating scores is done by looking for qtuples boundaries in all four |
| @@ -494,25 +494,25 @@ is non-nil. One interesting value is `turn-on-font-lock'." | |||
| 494 | ;; Finally all squares received the right increment, and then are up to | 494 | ;; Finally all squares received the right increment, and then are up to |
| 495 | ;; date, except possibly for SQUARE itself if we are taking a move back for | 495 | ;; date, except possibly for SQUARE itself if we are taking a move back for |
| 496 | ;; its score had been set to -1 at the time. | 496 | ;; its score had been set to -1 at the time. |
| 497 | (let* ((x (lm-index-to-x square)) | 497 | (let* ((x (landmark-index-to-x square)) |
| 498 | (y (lm-index-to-y square)) | 498 | (y (landmark-index-to-y square)) |
| 499 | (imin (max -4 (- 1 x))) | 499 | (imin (max -4 (- 1 x))) |
| 500 | (jmin (max -4 (- 1 y))) | 500 | (jmin (max -4 (- 1 y))) |
| 501 | (imax (min 0 (- lm-board-width x 4))) | 501 | (imax (min 0 (- landmark-board-width x 4))) |
| 502 | (jmax (min 0 (- lm-board-height y 4)))) | 502 | (jmax (min 0 (- landmark-board-height y 4)))) |
| 503 | (lm-update-score-in-direction imin imax | 503 | (landmark-update-score-in-direction imin imax |
| 504 | square 1 0 dval) | 504 | square 1 0 dval) |
| 505 | (lm-update-score-in-direction jmin jmax | 505 | (landmark-update-score-in-direction jmin jmax |
| 506 | square 0 1 dval) | 506 | square 0 1 dval) |
| 507 | (lm-update-score-in-direction (max imin jmin) (min imax jmax) | 507 | (landmark-update-score-in-direction (max imin jmin) (min imax jmax) |
| 508 | square 1 1 dval) | 508 | square 1 1 dval) |
| 509 | (lm-update-score-in-direction (max (- 1 y) -4 | 509 | (landmark-update-score-in-direction (max (- 1 y) -4 |
| 510 | (- x lm-board-width)) | 510 | (- x landmark-board-width)) |
| 511 | (min 0 (- x 5) | 511 | (min 0 (- x 5) |
| 512 | (- lm-board-height y 4)) | 512 | (- landmark-board-height y 4)) |
| 513 | square -1 1 dval))) | 513 | square -1 1 dval))) |
| 514 | 514 | ||
| 515 | (defun lm-update-score-in-direction (left right square dx dy dval) | 515 | (defun landmark-update-score-in-direction (left right square dx dy dval) |
| 516 | "Update scores for all squares in the qtuples in range. | 516 | "Update scores for all squares in the qtuples in range. |
| 517 | That is, those between the LEFTth square and the RIGHTth after SQUARE, | 517 | That is, those between the LEFTth square and the RIGHTth after SQUARE, |
| 518 | along the DX, DY direction, considering that DVAL has been added on SQUARE." | 518 | along the DX, DY direction, considering that DVAL has been added on SQUARE." |
| @@ -523,7 +523,7 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." | |||
| 523 | ((> left right)) ; Quit | 523 | ((> left right)) ; Quit |
| 524 | (t ; Else .. | 524 | (t ; Else .. |
| 525 | (let (depl square0 square1 square2 count delta) | 525 | (let (depl square0 square1 square2 count delta) |
| 526 | (setq depl (lm-xy-to-index dx dy) | 526 | (setq depl (landmark-xy-to-index dx dy) |
| 527 | square0 (+ square (* left depl)) | 527 | square0 (+ square (* left depl)) |
| 528 | square1 (+ square (* right depl)) | 528 | square1 (+ square (* right depl)) |
| 529 | square2 (+ square0 (* 4 depl))) | 529 | square2 (+ square0 (* 4 depl))) |
| @@ -531,25 +531,25 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." | |||
| 531 | (setq square square0 | 531 | (setq square square0 |
| 532 | count 0) | 532 | count 0) |
| 533 | (while (<= square square2) | 533 | (while (<= square square2) |
| 534 | (setq count (+ count (aref lm-board square)) | 534 | (setq count (+ count (aref landmark-board square)) |
| 535 | square (+ square depl))) | 535 | square (+ square depl))) |
| 536 | (while (<= square0 square1) | 536 | (while (<= square0 square1) |
| 537 | ;; Update the squares of the qtuple beginning in SQUARE0 and ending | 537 | ;; Update the squares of the qtuple beginning in SQUARE0 and ending |
| 538 | ;; in SQUARE2. | 538 | ;; in SQUARE2. |
| 539 | (setq delta (- (aref lm-score-trans-table count) | 539 | (setq delta (- (aref landmark-score-trans-table count) |
| 540 | (aref lm-score-trans-table (- count dval)))) | 540 | (aref landmark-score-trans-table (- count dval)))) |
| 541 | (cond ((not (zerop delta)) ; or else nothing to update | 541 | (cond ((not (zerop delta)) ; or else nothing to update |
| 542 | (setq square square0) | 542 | (setq square square0) |
| 543 | (while (<= square square2) | 543 | (while (<= square square2) |
| 544 | (if (zerop (aref lm-board square)) ; only for free squares | 544 | (if (zerop (aref landmark-board square)) ; only for free squares |
| 545 | (aset lm-score-table square | 545 | (aset landmark-score-table square |
| 546 | (+ (aref lm-score-table square) delta))) | 546 | (+ (aref landmark-score-table square) delta))) |
| 547 | (setq square (+ square depl))))) | 547 | (setq square (+ square depl))))) |
| 548 | ;; Then shift the qtuple one square along DEPL, this only requires | 548 | ;; Then shift the qtuple one square along DEPL, this only requires |
| 549 | ;; modifying SQUARE0 and SQUARE2. | 549 | ;; modifying SQUARE0 and SQUARE2. |
| 550 | (setq square2 (+ square2 depl) | 550 | (setq square2 (+ square2 depl) |
| 551 | count (+ count (- (aref lm-board square0)) | 551 | count (+ count (- (aref landmark-board square0)) |
| 552 | (aref lm-board square2)) | 552 | (aref landmark-board square2)) |
| 553 | square0 (+ square0 depl))))))) | 553 | square0 (+ square0 depl))))))) |
| 554 | 554 | ||
| 555 | ;;; | 555 | ;;; |
| @@ -561,328 +561,328 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." | |||
| 561 | ;; (anti-updating the score table) and to compute the table from scratch in | 561 | ;; (anti-updating the score table) and to compute the table from scratch in |
| 562 | ;; case of an interruption. | 562 | ;; case of an interruption. |
| 563 | 563 | ||
| 564 | (defvar lm-game-in-progress nil | 564 | (defvar landmark-game-in-progress nil |
| 565 | "Non-nil if a game is in progress.") | 565 | "Non-nil if a game is in progress.") |
| 566 | 566 | ||
| 567 | (defvar lm-game-history nil | 567 | (defvar landmark-game-history nil |
| 568 | "A record of all moves that have been played during current game.") | 568 | "A record of all moves that have been played during current game.") |
| 569 | 569 | ||
| 570 | (defvar lm-number-of-moves nil | 570 | (defvar landmark-number-of-moves nil |
| 571 | "Number of moves already played in current game.") | 571 | "Number of moves already played in current game.") |
| 572 | 572 | ||
| 573 | (defvar lm-number-of-human-moves nil | 573 | (defvar landmark-number-of-human-moves nil |
| 574 | "Number of moves already played by human in current game.") | 574 | "Number of moves already played by human in current game.") |
| 575 | 575 | ||
| 576 | (defvar lm-emacs-played-first nil | 576 | (defvar landmark-emacs-played-first nil |
| 577 | "Non-nil if Emacs played first.") | 577 | "Non-nil if Emacs played first.") |
| 578 | 578 | ||
| 579 | (defvar lm-human-took-back nil | 579 | (defvar landmark-human-took-back nil |
| 580 | "Non-nil if Human took back a move during the game.") | 580 | "Non-nil if Human took back a move during the game.") |
| 581 | 581 | ||
| 582 | (defvar lm-human-refused-draw nil | 582 | (defvar landmark-human-refused-draw nil |
| 583 | "Non-nil if Human refused Emacs offer of a draw.") | 583 | "Non-nil if Human refused Emacs offer of a draw.") |
| 584 | 584 | ||
| 585 | (defvar lm-emacs-is-computing nil | 585 | (defvar landmark-emacs-is-computing nil |
| 586 | ;; This is used to detect interruptions. Hopefully, it should not be needed. | 586 | ;; This is used to detect interruptions. Hopefully, it should not be needed. |
| 587 | "Non-nil if Emacs is in the middle of a computation.") | 587 | "Non-nil if Emacs is in the middle of a computation.") |
| 588 | 588 | ||
| 589 | 589 | ||
| 590 | (defun lm-start-game (n m) | 590 | (defun landmark-start-game (n m) |
| 591 | "Initialize a new game on an N by M board." | 591 | "Initialize a new game on an N by M board." |
| 592 | (setq lm-emacs-is-computing t) ; Raise flag | 592 | (setq landmark-emacs-is-computing t) ; Raise flag |
| 593 | (setq lm-game-in-progress t) | 593 | (setq landmark-game-in-progress t) |
| 594 | (setq lm-board-width n | 594 | (setq landmark-board-width n |
| 595 | lm-board-height m | 595 | landmark-board-height m |
| 596 | lm-vector-length (1+ (* (+ m 2) (1+ n))) | 596 | landmark-vector-length (1+ (* (+ m 2) (1+ n))) |
| 597 | lm-draw-limit (/ (* 7 n m) 10)) | 597 | landmark-draw-limit (/ (* 7 n m) 10)) |
| 598 | (setq lm-emacs-won nil | 598 | (setq landmark-emacs-won nil |
| 599 | lm-game-history nil | 599 | landmark-game-history nil |
| 600 | lm-number-of-moves 0 | 600 | landmark-number-of-moves 0 |
| 601 | lm-number-of-human-moves 0 | 601 | landmark-number-of-human-moves 0 |
| 602 | lm-emacs-played-first nil | 602 | landmark-emacs-played-first nil |
| 603 | lm-human-took-back nil | 603 | landmark-human-took-back nil |
| 604 | lm-human-refused-draw nil) | 604 | landmark-human-refused-draw nil) |
| 605 | (lm-init-display n m) ; Display first: the rest takes time | 605 | (landmark-init-display n m) ; Display first: the rest takes time |
| 606 | (lm-init-score-table) ; INIT-BOARD requires that the score | 606 | (landmark-init-score-table) ; INIT-BOARD requires that the score |
| 607 | (lm-init-board) ; table be already created. | 607 | (landmark-init-board) ; table be already created. |
| 608 | (setq lm-emacs-is-computing nil)) | 608 | (setq landmark-emacs-is-computing nil)) |
| 609 | 609 | ||
| 610 | (defun lm-play-move (square val &optional dont-update-score) | 610 | (defun landmark-play-move (square val &optional dont-update-score) |
| 611 | "Go to SQUARE, play VAL and update everything." | 611 | "Go to SQUARE, play VAL and update everything." |
| 612 | (setq lm-emacs-is-computing t) ; Raise flag | 612 | (setq landmark-emacs-is-computing t) ; Raise flag |
| 613 | (cond ((= 1 val) ; a Human move | 613 | (cond ((= 1 val) ; a Human move |
| 614 | (setq lm-number-of-human-moves (1+ lm-number-of-human-moves))) | 614 | (setq landmark-number-of-human-moves (1+ landmark-number-of-human-moves))) |
| 615 | ((zerop lm-number-of-moves) ; an Emacs move. Is it first ? | 615 | ((zerop landmark-number-of-moves) ; an Emacs move. Is it first ? |
| 616 | (setq lm-emacs-played-first t))) | 616 | (setq landmark-emacs-played-first t))) |
| 617 | (setq lm-game-history | 617 | (setq landmark-game-history |
| 618 | (cons (cons square (aref lm-score-table square)) | 618 | (cons (cons square (aref landmark-score-table square)) |
| 619 | lm-game-history) | 619 | landmark-game-history) |
| 620 | lm-number-of-moves (1+ lm-number-of-moves)) | 620 | landmark-number-of-moves (1+ landmark-number-of-moves)) |
| 621 | (lm-plot-square square val) | 621 | (landmark-plot-square square val) |
| 622 | (aset lm-board square val) ; *BEFORE* UPDATE-SCORE ! | 622 | (aset landmark-board square val) ; *BEFORE* UPDATE-SCORE ! |
| 623 | (if dont-update-score nil | 623 | (if dont-update-score nil |
| 624 | (lm-update-score-table square val) ; previous val was 0: dval = val | 624 | (landmark-update-score-table square val) ; previous val was 0: dval = val |
| 625 | (aset lm-score-table square -1)) | 625 | (aset landmark-score-table square -1)) |
| 626 | (setq lm-emacs-is-computing nil)) | 626 | (setq landmark-emacs-is-computing nil)) |
| 627 | 627 | ||
| 628 | (defun lm-take-back () | 628 | (defun landmark-take-back () |
| 629 | "Take back last move and update everything." | 629 | "Take back last move and update everything." |
| 630 | (setq lm-emacs-is-computing t) | 630 | (setq landmark-emacs-is-computing t) |
| 631 | (let* ((last-move (car lm-game-history)) | 631 | (let* ((last-move (car landmark-game-history)) |
| 632 | (square (car last-move)) | 632 | (square (car last-move)) |
| 633 | (oldval (aref lm-board square))) | 633 | (oldval (aref landmark-board square))) |
| 634 | (if (= 1 oldval) | 634 | (if (= 1 oldval) |
| 635 | (setq lm-number-of-human-moves (1- lm-number-of-human-moves))) | 635 | (setq landmark-number-of-human-moves (1- landmark-number-of-human-moves))) |
| 636 | (setq lm-game-history (cdr lm-game-history) | 636 | (setq landmark-game-history (cdr landmark-game-history) |
| 637 | lm-number-of-moves (1- lm-number-of-moves)) | 637 | landmark-number-of-moves (1- landmark-number-of-moves)) |
| 638 | (lm-plot-square square 0) | 638 | (landmark-plot-square square 0) |
| 639 | (aset lm-board square 0) ; *BEFORE* UPDATE-SCORE ! | 639 | (aset landmark-board square 0) ; *BEFORE* UPDATE-SCORE ! |
| 640 | (lm-update-score-table square (- oldval)) | 640 | (landmark-update-score-table square (- oldval)) |
| 641 | (aset lm-score-table square (cdr last-move))) | 641 | (aset landmark-score-table square (cdr last-move))) |
| 642 | (setq lm-emacs-is-computing nil)) | 642 | (setq landmark-emacs-is-computing nil)) |
| 643 | 643 | ||
| 644 | 644 | ||
| 645 | ;;;_ + SESSION CONTROL. | 645 | ;;;_ + SESSION CONTROL. |
| 646 | 646 | ||
| 647 | (defvar lm-number-of-trials 0 | 647 | (defvar landmark-number-of-trials 0 |
| 648 | "The number of times that landmark has been run.") | 648 | "The number of times that landmark has been run.") |
| 649 | 649 | ||
| 650 | (defvar lm-sum-of-moves 0 | 650 | (defvar landmark-sum-of-moves 0 |
| 651 | "The total number of moves made in all games.") | 651 | "The total number of moves made in all games.") |
| 652 | 652 | ||
| 653 | (defvar lm-number-of-emacs-wins 0 | 653 | (defvar landmark-number-of-emacs-wins 0 |
| 654 | "Number of games Emacs won in this session.") | 654 | "Number of games Emacs won in this session.") |
| 655 | 655 | ||
| 656 | (defvar lm-number-of-human-wins 0 | 656 | (defvar landmark-number-of-human-wins 0 |
| 657 | "Number of games you won in this session.") | 657 | "Number of games you won in this session.") |
| 658 | 658 | ||
| 659 | (defvar lm-number-of-draws 0 | 659 | (defvar landmark-number-of-draws 0 |
| 660 | "Number of games already drawn in this session.") | 660 | "Number of games already drawn in this session.") |
| 661 | 661 | ||
| 662 | 662 | ||
| 663 | (defun lm-terminate-game (result) | 663 | (defun landmark-terminate-game (result) |
| 664 | "Terminate the current game with RESULT." | 664 | "Terminate the current game with RESULT." |
| 665 | (setq lm-number-of-trials (1+ lm-number-of-trials)) | 665 | (setq landmark-number-of-trials (1+ landmark-number-of-trials)) |
| 666 | (setq lm-sum-of-moves (+ lm-sum-of-moves lm-number-of-moves)) | 666 | (setq landmark-sum-of-moves (+ landmark-sum-of-moves landmark-number-of-moves)) |
| 667 | (if (eq result 'crash-game) | 667 | (if (eq result 'crash-game) |
| 668 | (message | 668 | (message |
| 669 | "Sorry, I have been interrupted and cannot resume that game...")) | 669 | "Sorry, I have been interrupted and cannot resume that game...")) |
| 670 | (lm-display-statistics) | 670 | (landmark-display-statistics) |
| 671 | ;;(ding) | 671 | ;;(ding) |
| 672 | (setq lm-game-in-progress nil)) | 672 | (setq landmark-game-in-progress nil)) |
| 673 | 673 | ||
| 674 | (defun lm-crash-game () | 674 | (defun landmark-crash-game () |
| 675 | "What to do when Emacs detects it has been interrupted." | 675 | "What to do when Emacs detects it has been interrupted." |
| 676 | (setq lm-emacs-is-computing nil) | 676 | (setq landmark-emacs-is-computing nil) |
| 677 | (lm-terminate-game 'crash-game) | 677 | (landmark-terminate-game 'crash-game) |
| 678 | (sit-for 4) ; Let's see the message | 678 | (sit-for 4) ; Let's see the message |
| 679 | (lm-prompt-for-other-game)) | 679 | (landmark-prompt-for-other-game)) |
| 680 | 680 | ||
| 681 | 681 | ||
| 682 | ;;;_ + INTERACTIVE COMMANDS. | 682 | ;;;_ + INTERACTIVE COMMANDS. |
| 683 | 683 | ||
| 684 | (defun lm-emacs-plays () | 684 | (defun landmark-emacs-plays () |
| 685 | "Compute Emacs next move and play it." | 685 | "Compute Emacs next move and play it." |
| 686 | (interactive) | 686 | (interactive) |
| 687 | (lm-switch-to-window) | 687 | (landmark-switch-to-window) |
| 688 | (cond | 688 | (cond |
| 689 | (lm-emacs-is-computing | 689 | (landmark-emacs-is-computing |
| 690 | (lm-crash-game)) | 690 | (landmark-crash-game)) |
| 691 | ((not lm-game-in-progress) | 691 | ((not landmark-game-in-progress) |
| 692 | (lm-prompt-for-other-game)) | 692 | (landmark-prompt-for-other-game)) |
| 693 | (t | 693 | (t |
| 694 | (message "Let me think...") | 694 | (message "Let me think...") |
| 695 | (let (square score) | 695 | (let (square score) |
| 696 | (setq square (lm-strongest-square)) | 696 | (setq square (landmark-strongest-square)) |
| 697 | (cond ((null square) | 697 | (cond ((null square) |
| 698 | (lm-terminate-game 'nobody-won)) | 698 | (landmark-terminate-game 'nobody-won)) |
| 699 | (t | 699 | (t |
| 700 | (setq score (aref lm-score-table square)) | 700 | (setq score (aref landmark-score-table square)) |
| 701 | (lm-play-move square 6) | 701 | (landmark-play-move square 6) |
| 702 | (cond ((>= score lm-winning-threshold) | 702 | (cond ((>= score landmark-winning-threshold) |
| 703 | (setq lm-emacs-won t) ; for font-lock | 703 | (setq landmark-emacs-won t) ; for font-lock |
| 704 | (lm-find-filled-qtuple square 6) | 704 | (landmark-find-filled-qtuple square 6) |
| 705 | (lm-terminate-game 'emacs-won)) | 705 | (landmark-terminate-game 'emacs-won)) |
| 706 | ((zerop score) | 706 | ((zerop score) |
| 707 | (lm-terminate-game 'nobody-won)) | 707 | (landmark-terminate-game 'nobody-won)) |
| 708 | ((and (> lm-number-of-moves lm-draw-limit) | 708 | ((and (> landmark-number-of-moves landmark-draw-limit) |
| 709 | (not lm-human-refused-draw) | 709 | (not landmark-human-refused-draw) |
| 710 | (lm-offer-a-draw)) | 710 | (landmark-offer-a-draw)) |
| 711 | (lm-terminate-game 'draw-agreed)) | 711 | (landmark-terminate-game 'draw-agreed)) |
| 712 | (t | 712 | (t |
| 713 | (lm-prompt-for-move))))))))) | 713 | (landmark-prompt-for-move))))))))) |
| 714 | 714 | ||
| 715 | ;; For small square dimensions this is approximate, since though measured in | 715 | ;; For small square dimensions this is approximate, since though measured in |
| 716 | ;; pixels, event's (X . Y) is a character's top-left corner. | 716 | ;; pixels, event's (X . Y) is a character's top-left corner. |
| 717 | (defun lm-click (click) | 717 | (defun landmark-click (click) |
| 718 | "Position at the square where you click." | 718 | "Position at the square where you click." |
| 719 | (interactive "e") | 719 | (interactive "e") |
| 720 | (and (windowp (posn-window (setq click (event-end click)))) | 720 | (and (windowp (posn-window (setq click (event-end click)))) |
| 721 | (numberp (posn-point click)) | 721 | (numberp (posn-point click)) |
| 722 | (select-window (posn-window click)) | 722 | (select-window (posn-window click)) |
| 723 | (setq click (posn-col-row click)) | 723 | (setq click (posn-col-row click)) |
| 724 | (lm-goto-xy | 724 | (landmark-goto-xy |
| 725 | (min (max (/ (+ (- (car click) | 725 | (min (max (/ (+ (- (car click) |
| 726 | lm-x-offset | 726 | landmark-x-offset |
| 727 | 1) | 727 | 1) |
| 728 | (window-hscroll) | 728 | (window-hscroll) |
| 729 | lm-square-width | 729 | landmark-square-width |
| 730 | (% lm-square-width 2) | 730 | (% landmark-square-width 2) |
| 731 | (/ lm-square-width 2)) | 731 | (/ landmark-square-width 2)) |
| 732 | lm-square-width) | 732 | landmark-square-width) |
| 733 | 1) | 733 | 1) |
| 734 | lm-board-width) | 734 | landmark-board-width) |
| 735 | (min (max (/ (+ (- (cdr click) | 735 | (min (max (/ (+ (- (cdr click) |
| 736 | lm-y-offset | 736 | landmark-y-offset |
| 737 | 1) | 737 | 1) |
| 738 | (let ((inhibit-point-motion-hooks t)) | 738 | (let ((inhibit-point-motion-hooks t)) |
| 739 | (count-lines 1 (window-start))) | 739 | (count-lines 1 (window-start))) |
| 740 | lm-square-height | 740 | landmark-square-height |
| 741 | (% lm-square-height 2) | 741 | (% landmark-square-height 2) |
| 742 | (/ lm-square-height 2)) | 742 | (/ landmark-square-height 2)) |
| 743 | lm-square-height) | 743 | landmark-square-height) |
| 744 | 1) | 744 | 1) |
| 745 | lm-board-height)))) | 745 | landmark-board-height)))) |
| 746 | 746 | ||
| 747 | (defun lm-mouse-play (click) | 747 | (defun landmark-mouse-play (click) |
| 748 | "Play at the square where you click." | 748 | "Play at the square where you click." |
| 749 | (interactive "e") | 749 | (interactive "e") |
| 750 | (if (lm-click click) | 750 | (if (landmark-click click) |
| 751 | (lm-human-plays))) | 751 | (landmark-human-plays))) |
| 752 | 752 | ||
| 753 | (defun lm-human-plays () | 753 | (defun landmark-human-plays () |
| 754 | "Signal to the Lm program that you have played. | 754 | "Signal to the Landmark program that you have played. |
| 755 | You must have put the cursor on the square where you want to play. | 755 | You must have put the cursor on the square where you want to play. |
| 756 | If the game is finished, this command requests for another game." | 756 | If the game is finished, this command requests for another game." |
| 757 | (interactive) | 757 | (interactive) |
| 758 | (lm-switch-to-window) | 758 | (landmark-switch-to-window) |
| 759 | (cond | 759 | (cond |
| 760 | (lm-emacs-is-computing | 760 | (landmark-emacs-is-computing |
| 761 | (lm-crash-game)) | 761 | (landmark-crash-game)) |
| 762 | ((not lm-game-in-progress) | 762 | ((not landmark-game-in-progress) |
| 763 | (lm-prompt-for-other-game)) | 763 | (landmark-prompt-for-other-game)) |
| 764 | (t | 764 | (t |
| 765 | (let (square score) | 765 | (let (square score) |
| 766 | (setq square (lm-point-square)) | 766 | (setq square (landmark-point-square)) |
| 767 | (cond ((null square) | 767 | (cond ((null square) |
| 768 | (error "Your point is not on a square. Retry!")) | 768 | (error "Your point is not on a square. Retry!")) |
| 769 | ((not (zerop (aref lm-board square))) | 769 | ((not (zerop (aref landmark-board square))) |
| 770 | (error "Your point is not on a free square. Retry!")) | 770 | (error "Your point is not on a free square. Retry!")) |
| 771 | (t | 771 | (t |
| 772 | (setq score (aref lm-score-table square)) | 772 | (setq score (aref landmark-score-table square)) |
| 773 | (lm-play-move square 1) | 773 | (landmark-play-move square 1) |
| 774 | (cond ((and (>= score lm-losing-threshold) | 774 | (cond ((and (>= score landmark-losing-threshold) |
| 775 | ;; Just testing SCORE > THRESHOLD is not enough for | 775 | ;; Just testing SCORE > THRESHOLD is not enough for |
| 776 | ;; detecting wins, it just gives an indication that | 776 | ;; detecting wins, it just gives an indication that |
| 777 | ;; we confirm with LM-FIND-FILLED-QTUPLE. | 777 | ;; we confirm with LANDMARK-FIND-FILLED-QTUPLE. |
| 778 | (lm-find-filled-qtuple square 1)) | 778 | (landmark-find-filled-qtuple square 1)) |
| 779 | (lm-terminate-game 'human-won)) | 779 | (landmark-terminate-game 'human-won)) |
| 780 | (t | 780 | (t |
| 781 | (lm-emacs-plays))))))))) | 781 | (landmark-emacs-plays))))))))) |
| 782 | 782 | ||
| 783 | (defun lm-human-takes-back () | 783 | (defun landmark-human-takes-back () |
| 784 | "Signal to the Lm program that you wish to take back your last move." | 784 | "Signal to the Landmark program that you wish to take back your last move." |
| 785 | (interactive) | 785 | (interactive) |
| 786 | (lm-switch-to-window) | 786 | (landmark-switch-to-window) |
| 787 | (cond | 787 | (cond |
| 788 | (lm-emacs-is-computing | 788 | (landmark-emacs-is-computing |
| 789 | (lm-crash-game)) | 789 | (landmark-crash-game)) |
| 790 | ((not lm-game-in-progress) | 790 | ((not landmark-game-in-progress) |
| 791 | (message "Too late for taking back...") | 791 | (message "Too late for taking back...") |
| 792 | (sit-for 4) | 792 | (sit-for 4) |
| 793 | (lm-prompt-for-other-game)) | 793 | (landmark-prompt-for-other-game)) |
| 794 | ((zerop lm-number-of-human-moves) | 794 | ((zerop landmark-number-of-human-moves) |
| 795 | (message "You have not played yet... Your move?")) | 795 | (message "You have not played yet... Your move?")) |
| 796 | (t | 796 | (t |
| 797 | (message "One moment, please...") | 797 | (message "One moment, please...") |
| 798 | ;; It is possible for the user to let Emacs play several consecutive | 798 | ;; It is possible for the user to let Emacs play several consecutive |
| 799 | ;; moves, so that the best way to know when to stop taking back moves is | 799 | ;; moves, so that the best way to know when to stop taking back moves is |
| 800 | ;; to count the number of human moves: | 800 | ;; to count the number of human moves: |
| 801 | (setq lm-human-took-back t) | 801 | (setq landmark-human-took-back t) |
| 802 | (let ((number lm-number-of-human-moves)) | 802 | (let ((number landmark-number-of-human-moves)) |
| 803 | (while (= number lm-number-of-human-moves) | 803 | (while (= number landmark-number-of-human-moves) |
| 804 | (lm-take-back))) | 804 | (landmark-take-back))) |
| 805 | (lm-prompt-for-move)))) | 805 | (landmark-prompt-for-move)))) |
| 806 | 806 | ||
| 807 | (defun lm-human-resigns () | 807 | (defun landmark-human-resigns () |
| 808 | "Signal to the Lm program that you may want to resign." | 808 | "Signal to the Landmark program that you may want to resign." |
| 809 | (interactive) | 809 | (interactive) |
| 810 | (lm-switch-to-window) | 810 | (landmark-switch-to-window) |
| 811 | (cond | 811 | (cond |
| 812 | (lm-emacs-is-computing | 812 | (landmark-emacs-is-computing |
| 813 | (lm-crash-game)) | 813 | (landmark-crash-game)) |
| 814 | ((not lm-game-in-progress) | 814 | ((not landmark-game-in-progress) |
| 815 | (message "There is no game in progress")) | 815 | (message "There is no game in progress")) |
| 816 | ((y-or-n-p "You mean, you resign? ") | 816 | ((y-or-n-p "You mean, you resign? ") |
| 817 | (lm-terminate-game 'human-resigned)) | 817 | (landmark-terminate-game 'human-resigned)) |
| 818 | ((y-or-n-p "You mean, we continue? ") | 818 | ((y-or-n-p "You mean, we continue? ") |
| 819 | (lm-prompt-for-move)) | 819 | (landmark-prompt-for-move)) |
| 820 | (t | 820 | (t |
| 821 | (lm-terminate-game 'human-resigned)))) ; OK. Accept it | 821 | (landmark-terminate-game 'human-resigned)))) ; OK. Accept it |
| 822 | 822 | ||
| 823 | ;;;_ + PROMPTING THE HUMAN PLAYER. | 823 | ;;;_ + PROMPTING THE HUMAN PLAYER. |
| 824 | 824 | ||
| 825 | (defun lm-prompt-for-move () | 825 | (defun landmark-prompt-for-move () |
| 826 | "Display a message asking for Human's move." | 826 | "Display a message asking for Human's move." |
| 827 | (message (if (zerop lm-number-of-human-moves) | 827 | (message (if (zerop landmark-number-of-human-moves) |
| 828 | "Your move? (move to a free square and hit X, RET ...)" | 828 | "Your move? (move to a free square and hit X, RET ...)" |
| 829 | "Your move?"))) | 829 | "Your move?"))) |
| 830 | 830 | ||
| 831 | (defun lm-prompt-for-other-game () | 831 | (defun landmark-prompt-for-other-game () |
| 832 | "Ask for another game, and start it." | 832 | "Ask for another game, and start it." |
| 833 | (if (y-or-n-p "Another game? ") | 833 | (if (y-or-n-p "Another game? ") |
| 834 | (if (y-or-n-p "Retain learned weights ") | 834 | (if (y-or-n-p "Retain learned weights ") |
| 835 | (lm 2) | 835 | (landmark 2) |
| 836 | (lm 1)) | 836 | (landmark 1)) |
| 837 | (message "Chicken!"))) | 837 | (message "Chicken!"))) |
| 838 | 838 | ||
| 839 | (defun lm-offer-a-draw () | 839 | (defun landmark-offer-a-draw () |
| 840 | "Offer a draw and return t if Human accepted it." | 840 | "Offer a draw and return t if Human accepted it." |
| 841 | (or (y-or-n-p "I offer you a draw. Do you accept it? ") | 841 | (or (y-or-n-p "I offer you a draw. Do you accept it? ") |
| 842 | (not (setq lm-human-refused-draw t)))) | 842 | (not (setq landmark-human-refused-draw t)))) |
| 843 | 843 | ||
| 844 | 844 | ||
| 845 | (defun lm-max-width () | 845 | (defun landmark-max-width () |
| 846 | "Largest possible board width for the current window." | 846 | "Largest possible board width for the current window." |
| 847 | (1+ (/ (- (window-width (selected-window)) | 847 | (1+ (/ (- (window-width (selected-window)) |
| 848 | lm-x-offset lm-x-offset 1) | 848 | landmark-x-offset landmark-x-offset 1) |
| 849 | lm-square-width))) | 849 | landmark-square-width))) |
| 850 | 850 | ||
| 851 | (defun lm-max-height () | 851 | (defun landmark-max-height () |
| 852 | "Largest possible board height for the current window." | 852 | "Largest possible board height for the current window." |
| 853 | (1+ (/ (- (window-height (selected-window)) | 853 | (1+ (/ (- (window-height (selected-window)) |
| 854 | lm-y-offset lm-y-offset 2) | 854 | landmark-y-offset landmark-y-offset 2) |
| 855 | ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! | 855 | ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! |
| 856 | lm-square-height))) | 856 | landmark-square-height))) |
| 857 | 857 | ||
| 858 | (defun lm-point-y () | 858 | (defun landmark-point-y () |
| 859 | "Return the board row where point is." | 859 | "Return the board row where point is." |
| 860 | (let ((inhibit-point-motion-hooks t)) | 860 | (let ((inhibit-point-motion-hooks t)) |
| 861 | (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1)) | 861 | (1+ (/ (- (count-lines 1 (point)) landmark-y-offset (if (bolp) 0 1)) |
| 862 | lm-square-height)))) | 862 | landmark-square-height)))) |
| 863 | 863 | ||
| 864 | (defun lm-point-square () | 864 | (defun landmark-point-square () |
| 865 | "Return the index of the square point is on." | 865 | "Return the index of the square point is on." |
| 866 | (let ((inhibit-point-motion-hooks t)) | 866 | (let ((inhibit-point-motion-hooks t)) |
| 867 | (lm-xy-to-index (1+ (/ (- (current-column) lm-x-offset) | 867 | (landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset) |
| 868 | lm-square-width)) | 868 | landmark-square-width)) |
| 869 | (lm-point-y)))) | 869 | (landmark-point-y)))) |
| 870 | 870 | ||
| 871 | (defun lm-goto-square (index) | 871 | (defun landmark-goto-square (index) |
| 872 | "Move point to square number INDEX." | 872 | "Move point to square number INDEX." |
| 873 | (lm-goto-xy (lm-index-to-x index) (lm-index-to-y index))) | 873 | (landmark-goto-xy (landmark-index-to-x index) (landmark-index-to-y index))) |
| 874 | 874 | ||
| 875 | (defun lm-goto-xy (x y) | 875 | (defun landmark-goto-xy (x y) |
| 876 | "Move point to square at X, Y coords." | 876 | "Move point to square at X, Y coords." |
| 877 | (let ((inhibit-point-motion-hooks t)) | 877 | (let ((inhibit-point-motion-hooks t)) |
| 878 | (goto-char (point-min)) | 878 | (goto-char (point-min)) |
| 879 | (forward-line (+ lm-y-offset (* lm-square-height (1- y))))) | 879 | (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))) |
| 880 | (move-to-column (+ lm-x-offset (* lm-square-width (1- x))))) | 880 | (move-to-column (+ landmark-x-offset (* landmark-square-width (1- x))))) |
| 881 | 881 | ||
| 882 | (defun lm-plot-square (square value) | 882 | (defun landmark-plot-square (square value) |
| 883 | "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." | 883 | "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." |
| 884 | (or (= value 1) | 884 | (or (= value 1) |
| 885 | (lm-goto-square square)) | 885 | (landmark-goto-square square)) |
| 886 | (let ((inhibit-read-only t) | 886 | (let ((inhibit-read-only t) |
| 887 | (inhibit-point-motion-hooks t)) | 887 | (inhibit-point-motion-hooks t)) |
| 888 | (insert-and-inherit (cond ((= value 1) ?.) | 888 | (insert-and-inherit (cond ((= value 1) ?.) |
| @@ -901,8 +901,8 @@ mouse-1: get robot moving, mouse-2: play on this square"))) | |||
| 901 | (backward-char 1)) | 901 | (backward-char 1)) |
| 902 | (sit-for 0)) ; Display NOW | 902 | (sit-for 0)) ; Display NOW |
| 903 | 903 | ||
| 904 | (defun lm-init-display (n m) | 904 | (defun landmark-init-display (n m) |
| 905 | "Display an N by M Lm board." | 905 | "Display an N by M Landmark board." |
| 906 | (buffer-disable-undo (current-buffer)) | 906 | (buffer-disable-undo (current-buffer)) |
| 907 | (let ((inhibit-read-only t) | 907 | (let ((inhibit-read-only t) |
| 908 | (point 1) opoint | 908 | (point 1) opoint |
| @@ -910,17 +910,17 @@ mouse-1: get robot moving, mouse-2: play on this square"))) | |||
| 910 | (i m) j x) | 910 | (i m) j x) |
| 911 | ;; Try to minimize number of chars (because of text properties) | 911 | ;; Try to minimize number of chars (because of text properties) |
| 912 | (setq tab-width | 912 | (setq tab-width |
| 913 | (if (zerop (% lm-x-offset lm-square-width)) | 913 | (if (zerop (% landmark-x-offset landmark-square-width)) |
| 914 | lm-square-width | 914 | landmark-square-width |
| 915 | (max (/ (+ (% lm-x-offset lm-square-width) | 915 | (max (/ (+ (% landmark-x-offset landmark-square-width) |
| 916 | lm-square-width 1) 2) 2))) | 916 | landmark-square-width 1) 2) 2))) |
| 917 | (erase-buffer) | 917 | (erase-buffer) |
| 918 | (newline lm-y-offset) | 918 | (newline landmark-y-offset) |
| 919 | (while (progn | 919 | (while (progn |
| 920 | (setq j n | 920 | (setq j n |
| 921 | x (- lm-x-offset lm-square-width)) | 921 | x (- landmark-x-offset landmark-square-width)) |
| 922 | (while (>= (setq j (1- j)) 0) | 922 | (while (>= (setq j (1- j)) 0) |
| 923 | (insert-char ?\t (/ (- (setq x (+ x lm-square-width)) | 923 | (insert-char ?\t (/ (- (setq x (+ x landmark-square-width)) |
| 924 | (current-column)) | 924 | (current-column)) |
| 925 | tab-width)) | 925 | tab-width)) |
| 926 | (insert-char ? (- x (current-column))) | 926 | (insert-char ? (- x (current-column))) |
| @@ -941,7 +941,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) | |||
| 941 | (> (setq i (1- i)) 0)) | 941 | (> (setq i (1- i)) 0)) |
| 942 | (if (= i (1- m)) | 942 | (if (= i (1- m)) |
| 943 | (setq opoint point)) | 943 | (setq opoint point)) |
| 944 | (insert-char ?\n lm-square-height)) | 944 | (insert-char ?\n landmark-square-height)) |
| 945 | (or (eq (char-after 1) ?.) | 945 | (or (eq (char-after 1) ?.) |
| 946 | (put-text-property 1 2 'point-entered | 946 | (put-text-property 1 2 'point-entered |
| 947 | (lambda (x y) (if (bobp) (forward-char))))) | 947 | (lambda (x y) (if (bobp) (forward-char))))) |
| @@ -949,32 +949,32 @@ mouse-1: get robot moving, mouse-2: play on this square"))) | |||
| 949 | (put-text-property point (point) 'intangible 2)) | 949 | (put-text-property point (point) 'intangible 2)) |
| 950 | (put-text-property point (point) 'point-entered | 950 | (put-text-property point (point) 'point-entered |
| 951 | (lambda (x y) (if (eobp) (backward-char)))) | 951 | (lambda (x y) (if (eobp) (backward-char)))) |
| 952 | (put-text-property (point-min) (point) 'category 'lm-mode)) | 952 | (put-text-property (point-min) (point) 'category 'landmark-mode)) |
| 953 | (lm-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board | 953 | (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board |
| 954 | (sit-for 0)) ; Display NOW | 954 | (sit-for 0)) ; Display NOW |
| 955 | 955 | ||
| 956 | (defun lm-display-statistics () | 956 | (defun landmark-display-statistics () |
| 957 | "Obnoxiously display some statistics about previous games in mode line." | 957 | "Obnoxiously display some statistics about previous games in mode line." |
| 958 | ;; We store this string in the mode-line-process local variable. | 958 | ;; We store this string in the mode-line-process local variable. |
| 959 | ;; This is certainly not the cleanest way out ... | 959 | ;; This is certainly not the cleanest way out ... |
| 960 | (setq mode-line-process | 960 | (setq mode-line-process |
| 961 | (format ": Trials: %d, Avg#Moves: %d" | 961 | (format ": Trials: %d, Avg#Moves: %d" |
| 962 | lm-number-of-trials | 962 | landmark-number-of-trials |
| 963 | (if (zerop lm-number-of-trials) | 963 | (if (zerop landmark-number-of-trials) |
| 964 | 0 | 964 | 0 |
| 965 | (/ lm-sum-of-moves lm-number-of-trials)))) | 965 | (/ landmark-sum-of-moves landmark-number-of-trials)))) |
| 966 | (force-mode-line-update)) | 966 | (force-mode-line-update)) |
| 967 | 967 | ||
| 968 | (defun lm-switch-to-window () | 968 | (defun landmark-switch-to-window () |
| 969 | "Find or create the Lm buffer, and display it." | 969 | "Find or create the Landmark buffer, and display it." |
| 970 | (interactive) | 970 | (interactive) |
| 971 | (let ((buff (get-buffer "*Lm*"))) | 971 | (let ((buff (get-buffer "*Landmark*"))) |
| 972 | (if buff ; Buffer exists: | 972 | (if buff ; Buffer exists: |
| 973 | (switch-to-buffer buff) ; no problem. | 973 | (switch-to-buffer buff) ; no problem. |
| 974 | (if lm-game-in-progress | 974 | (if landmark-game-in-progress |
| 975 | (lm-crash-game)) ; buffer has been killed or something | 975 | (landmark-crash-game)) ; buffer has been killed or something |
| 976 | (switch-to-buffer "*Lm*") ; Anyway, start anew. | 976 | (switch-to-buffer "*Landmark*") ; Anyway, start anew. |
| 977 | (lm-mode)))) | 977 | (landmark-mode)))) |
| 978 | 978 | ||
| 979 | 979 | ||
| 980 | ;;;_ + CROSSING WINNING QTUPLES. | 980 | ;;;_ + CROSSING WINNING QTUPLES. |
| @@ -984,61 +984,61 @@ mouse-1: get robot moving, mouse-2: play on this square"))) | |||
| 984 | ;; squares ! It only knows the square where the last move has been played and | 984 | ;; squares ! It only knows the square where the last move has been played and |
| 985 | ;; who won. The solution is to scan the board along all four directions. | 985 | ;; who won. The solution is to scan the board along all four directions. |
| 986 | 986 | ||
| 987 | (defun lm-find-filled-qtuple (square value) | 987 | (defun landmark-find-filled-qtuple (square value) |
| 988 | "Return t if SQUARE belongs to a qtuple filled with VALUEs." | 988 | "Return t if SQUARE belongs to a qtuple filled with VALUEs." |
| 989 | (or (lm-check-filled-qtuple square value 1 0) | 989 | (or (landmark-check-filled-qtuple square value 1 0) |
| 990 | (lm-check-filled-qtuple square value 0 1) | 990 | (landmark-check-filled-qtuple square value 0 1) |
| 991 | (lm-check-filled-qtuple square value 1 1) | 991 | (landmark-check-filled-qtuple square value 1 1) |
| 992 | (lm-check-filled-qtuple square value -1 1))) | 992 | (landmark-check-filled-qtuple square value -1 1))) |
| 993 | 993 | ||
| 994 | (defun lm-check-filled-qtuple (square value dx dy) | 994 | (defun landmark-check-filled-qtuple (square value dx dy) |
| 995 | "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." | 995 | "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." |
| 996 | (let ((a 0) (b 0) | 996 | (let ((a 0) (b 0) |
| 997 | (left square) (right square) | 997 | (left square) (right square) |
| 998 | (depl (lm-xy-to-index dx dy))) | 998 | (depl (landmark-xy-to-index dx dy))) |
| 999 | (while (and (> a -4) ; stretch tuple left | 999 | (while (and (> a -4) ; stretch tuple left |
| 1000 | (= value (aref lm-board (setq left (- left depl))))) | 1000 | (= value (aref landmark-board (setq left (- left depl))))) |
| 1001 | (setq a (1- a))) | 1001 | (setq a (1- a))) |
| 1002 | (while (and (< b (+ a 4)) ; stretch tuple right | 1002 | (while (and (< b (+ a 4)) ; stretch tuple right |
| 1003 | (= value (aref lm-board (setq right (+ right depl))))) | 1003 | (= value (aref landmark-board (setq right (+ right depl))))) |
| 1004 | (setq b (1+ b))) | 1004 | (setq b (1+ b))) |
| 1005 | (cond ((= b (+ a 4)) ; tuple length = 5 ? | 1005 | (cond ((= b (+ a 4)) ; tuple length = 5 ? |
| 1006 | (lm-cross-qtuple (+ square (* a depl)) (+ square (* b depl)) | 1006 | (landmark-cross-qtuple (+ square (* a depl)) (+ square (* b depl)) |
| 1007 | dx dy) | 1007 | dx dy) |
| 1008 | t)))) | 1008 | t)))) |
| 1009 | 1009 | ||
| 1010 | (defun lm-cross-qtuple (square1 square2 dx dy) | 1010 | (defun landmark-cross-qtuple (square1 square2 dx dy) |
| 1011 | "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." | 1011 | "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." |
| 1012 | (save-excursion ; Not moving point from last square | 1012 | (save-excursion ; Not moving point from last square |
| 1013 | (let ((depl (lm-xy-to-index dx dy)) | 1013 | (let ((depl (landmark-xy-to-index dx dy)) |
| 1014 | (inhibit-read-only t) | 1014 | (inhibit-read-only t) |
| 1015 | (inhibit-point-motion-hooks t)) | 1015 | (inhibit-point-motion-hooks t)) |
| 1016 | ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 | 1016 | ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 |
| 1017 | (while (/= square1 square2) | 1017 | (while (/= square1 square2) |
| 1018 | (lm-goto-square square1) | 1018 | (landmark-goto-square square1) |
| 1019 | (setq square1 (+ square1 depl)) | 1019 | (setq square1 (+ square1 depl)) |
| 1020 | (cond | 1020 | (cond |
| 1021 | ((= dy 0) ; Horizontal | 1021 | ((= dy 0) ; Horizontal |
| 1022 | (forward-char 1) | 1022 | (forward-char 1) |
| 1023 | (insert-char ?- (1- lm-square-width) t) | 1023 | (insert-char ?- (1- landmark-square-width) t) |
| 1024 | (delete-region (point) (progn | 1024 | (delete-region (point) (progn |
| 1025 | (skip-chars-forward " \t") | 1025 | (skip-chars-forward " \t") |
| 1026 | (point)))) | 1026 | (point)))) |
| 1027 | ((= dx 0) ; Vertical | 1027 | ((= dx 0) ; Vertical |
| 1028 | (let ((lm-n 1) | 1028 | (let ((landmark-n 1) |
| 1029 | (column (current-column))) | 1029 | (column (current-column))) |
| 1030 | (while (< lm-n lm-square-height) | 1030 | (while (< landmark-n landmark-square-height) |
| 1031 | (setq lm-n (1+ lm-n)) | 1031 | (setq landmark-n (1+ landmark-n)) |
| 1032 | (forward-line 1) | 1032 | (forward-line 1) |
| 1033 | (indent-to column) | 1033 | (indent-to column) |
| 1034 | (insert-and-inherit ?|)))) | 1034 | (insert-and-inherit ?|)))) |
| 1035 | ((= dx -1) ; 1st Diagonal | 1035 | ((= dx -1) ; 1st Diagonal |
| 1036 | (indent-to (prog1 (- (current-column) (/ lm-square-width 2)) | 1036 | (indent-to (prog1 (- (current-column) (/ landmark-square-width 2)) |
| 1037 | (forward-line (/ lm-square-height 2)))) | 1037 | (forward-line (/ landmark-square-height 2)))) |
| 1038 | (insert-and-inherit ?/)) | 1038 | (insert-and-inherit ?/)) |
| 1039 | (t ; 2nd Diagonal | 1039 | (t ; 2nd Diagonal |
| 1040 | (indent-to (prog1 (+ (current-column) (/ lm-square-width 2)) | 1040 | (indent-to (prog1 (+ (current-column) (/ landmark-square-width 2)) |
| 1041 | (forward-line (/ lm-square-height 2)))) | 1041 | (forward-line (/ landmark-square-height 2)))) |
| 1042 | (insert-and-inherit ?\\)))))) | 1042 | (insert-and-inherit ?\\)))))) |
| 1043 | (sit-for 0)) ; Display NOW | 1043 | (sit-for 0)) ; Display NOW |
| 1044 | 1044 | ||
| @@ -1046,301 +1046,301 @@ mouse-1: get robot moving, mouse-2: play on this square"))) | |||
| 1046 | ;;;_ + CURSOR MOTION. | 1046 | ;;;_ + CURSOR MOTION. |
| 1047 | 1047 | ||
| 1048 | ;; previous-line and next-line don't work right with intangible newlines | 1048 | ;; previous-line and next-line don't work right with intangible newlines |
| 1049 | (defun lm-move-down () | 1049 | (defun landmark-move-down () |
| 1050 | "Move point down one row on the Lm board." | 1050 | "Move point down one row on the Landmark board." |
| 1051 | (interactive) | 1051 | (interactive) |
| 1052 | (if (< (lm-point-y) lm-board-height) | 1052 | (if (< (landmark-point-y) landmark-board-height) |
| 1053 | (forward-line 1)));;; lm-square-height))) | 1053 | (forward-line 1)));;; landmark-square-height))) |
| 1054 | 1054 | ||
| 1055 | (defun lm-move-up () | 1055 | (defun landmark-move-up () |
| 1056 | "Move point up one row on the Lm board." | 1056 | "Move point up one row on the Landmark board." |
| 1057 | (interactive) | 1057 | (interactive) |
| 1058 | (if (> (lm-point-y) 1) | 1058 | (if (> (landmark-point-y) 1) |
| 1059 | (forward-line (- lm-square-height)))) | 1059 | (forward-line (- landmark-square-height)))) |
| 1060 | 1060 | ||
| 1061 | (defun lm-move-ne () | 1061 | (defun landmark-move-ne () |
| 1062 | "Move point North East on the Lm board." | 1062 | "Move point North East on the Landmark board." |
| 1063 | (interactive) | 1063 | (interactive) |
| 1064 | (lm-move-up) | 1064 | (landmark-move-up) |
| 1065 | (forward-char)) | 1065 | (forward-char)) |
| 1066 | 1066 | ||
| 1067 | (defun lm-move-se () | 1067 | (defun landmark-move-se () |
| 1068 | "Move point South East on the Lm board." | 1068 | "Move point South East on the Landmark board." |
| 1069 | (interactive) | 1069 | (interactive) |
| 1070 | (lm-move-down) | 1070 | (landmark-move-down) |
| 1071 | (forward-char)) | 1071 | (forward-char)) |
| 1072 | 1072 | ||
| 1073 | (defun lm-move-nw () | 1073 | (defun landmark-move-nw () |
| 1074 | "Move point North West on the Lm board." | 1074 | "Move point North West on the Landmark board." |
| 1075 | (interactive) | 1075 | (interactive) |
| 1076 | (lm-move-up) | 1076 | (landmark-move-up) |
| 1077 | (backward-char)) | 1077 | (backward-char)) |
| 1078 | 1078 | ||
| 1079 | (defun lm-move-sw () | 1079 | (defun landmark-move-sw () |
| 1080 | "Move point South West on the Lm board." | 1080 | "Move point South West on the Landmark board." |
| 1081 | (interactive) | 1081 | (interactive) |
| 1082 | (lm-move-down) | 1082 | (landmark-move-down) |
| 1083 | (backward-char)) | 1083 | (backward-char)) |
| 1084 | 1084 | ||
| 1085 | (defun lm-beginning-of-line () | 1085 | (defun landmark-beginning-of-line () |
| 1086 | "Move point to first square on the Lm board row." | 1086 | "Move point to first square on the Landmark board row." |
| 1087 | (interactive) | 1087 | (interactive) |
| 1088 | (move-to-column lm-x-offset)) | 1088 | (move-to-column landmark-x-offset)) |
| 1089 | 1089 | ||
| 1090 | (defun lm-end-of-line () | 1090 | (defun landmark-end-of-line () |
| 1091 | "Move point to last square on the Lm board row." | 1091 | "Move point to last square on the Landmark board row." |
| 1092 | (interactive) | 1092 | (interactive) |
| 1093 | (move-to-column (+ lm-x-offset | 1093 | (move-to-column (+ landmark-x-offset |
| 1094 | (* lm-square-width (1- lm-board-width))))) | 1094 | (* landmark-square-width (1- landmark-board-width))))) |
| 1095 | 1095 | ||
| 1096 | 1096 | ||
| 1097 | ;;;_ + Simulation variables | 1097 | ;;;_ + Simulation variables |
| 1098 | 1098 | ||
| 1099 | ;;;_ - lm-nvar | 1099 | ;;;_ - landmark-nvar |
| 1100 | (defvar lm-nvar 0.0075 | 1100 | (defvar landmark-nvar 0.0075 |
| 1101 | "Not used. | 1101 | "Not used. |
| 1102 | Affects a noise generator which was used in an earlier incarnation of | 1102 | Affects a noise generator which was used in an earlier incarnation of |
| 1103 | this program to add a random element to the way moves were made.") | 1103 | this program to add a random element to the way moves were made.") |
| 1104 | ;;;_ - lists of cardinal directions | 1104 | ;;;_ - lists of cardinal directions |
| 1105 | ;;;_ : | 1105 | ;;;_ : |
| 1106 | (defvar lm-ns '(lm-n lm-s) | 1106 | (defvar landmark-ns '(landmark-n landmark-s) |
| 1107 | "Used when doing something relative to the north and south axes.") | 1107 | "Used when doing something relative to the north and south axes.") |
| 1108 | (defvar lm-ew '(lm-e lm-w) | 1108 | (defvar landmark-ew '(landmark-e landmark-w) |
| 1109 | "Used when doing something relative to the east and west axes.") | 1109 | "Used when doing something relative to the east and west axes.") |
| 1110 | (defvar lm-directions '(lm-n lm-s lm-e lm-w) | 1110 | (defvar landmark-directions '(landmark-n landmark-s landmark-e landmark-w) |
| 1111 | "The cardinal directions.") | 1111 | "The cardinal directions.") |
| 1112 | (defvar lm-8-directions | 1112 | (defvar landmark-8-directions |
| 1113 | '((lm-n) (lm-n lm-w) (lm-w) (lm-s lm-w) | 1113 | '((landmark-n) (landmark-n landmark-w) (landmark-w) (landmark-s landmark-w) |
| 1114 | (lm-s) (lm-s lm-e) (lm-e) (lm-n lm-e)) | 1114 | (landmark-s) (landmark-s landmark-e) (landmark-e) (landmark-n landmark-e)) |
| 1115 | "The full 8 possible directions.") | 1115 | "The full 8 possible directions.") |
| 1116 | 1116 | ||
| 1117 | (defvar lm-number-of-moves | 1117 | (defvar landmark-number-of-moves |
| 1118 | "The number of moves made by the robot so far.") | 1118 | "The number of moves made by the robot so far.") |
| 1119 | 1119 | ||
| 1120 | 1120 | ||
| 1121 | ;;;_* Terry's mods to create lm.el | 1121 | ;;;_* Terry's mods to create lm.el |
| 1122 | 1122 | ||
| 1123 | ;;;(setq lm-debug nil) | 1123 | ;;;(setq landmark-debug nil) |
| 1124 | (defvar lm-debug nil | 1124 | (defvar landmark-debug nil |
| 1125 | "If non-nil, debugging is printed.") | 1125 | "If non-nil, debugging is printed.") |
| 1126 | (defcustom lm-one-moment-please nil | 1126 | (defcustom landmark-one-moment-please nil |
| 1127 | "If non-nil, print \"One moment please\" when a new board is generated. | 1127 | "If non-nil, print \"One moment please\" when a new board is generated. |
| 1128 | The drawback of this is you don't see how many moves the last run took | 1128 | The drawback of this is you don't see how many moves the last run took |
| 1129 | because it is overwritten by \"One moment please\"." | 1129 | because it is overwritten by \"One moment please\"." |
| 1130 | :type 'boolean | 1130 | :type 'boolean |
| 1131 | :group 'lm) | 1131 | :group 'landmark) |
| 1132 | (defcustom lm-output-moves t | 1132 | (defcustom landmark-output-moves t |
| 1133 | "If non-nil, output number of moves so far on a move-by-move basis." | 1133 | "If non-nil, output number of moves so far on a move-by-move basis." |
| 1134 | :type 'boolean | 1134 | :type 'boolean |
| 1135 | :group 'lm) | 1135 | :group 'landmark) |
| 1136 | 1136 | ||
| 1137 | 1137 | ||
| 1138 | (defun lm-weights-debug () | 1138 | (defun landmark-weights-debug () |
| 1139 | (if lm-debug | 1139 | (if landmark-debug |
| 1140 | (progn (lm-print-wts) (lm-blackbox) (lm-print-y-s-noise) | 1140 | (progn (landmark-print-wts) (landmark-blackbox) (landmark-print-y-s-noise) |
| 1141 | (lm-print-smell)))) | 1141 | (landmark-print-smell)))) |
| 1142 | 1142 | ||
| 1143 | ;;;_ - Printing various things | 1143 | ;;;_ - Printing various things |
| 1144 | (defun lm-print-distance-int (direction) | 1144 | (defun landmark-print-distance-int (direction) |
| 1145 | (interactive) | 1145 | (interactive) |
| 1146 | (insert (format "%S %S " direction (get direction 'distance)))) | 1146 | (insert (format "%S %S " direction (get direction 'distance)))) |
| 1147 | 1147 | ||
| 1148 | 1148 | ||
| 1149 | (defun lm-print-distance () | 1149 | (defun landmark-print-distance () |
| 1150 | (insert (format "tree: %S \n" (calc-distance-of-robot-from 'lm-tree))) | 1150 | (insert (format "tree: %S \n" (calc-distance-of-robot-from 'landmark-tree))) |
| 1151 | (mapc 'lm-print-distance-int lm-directions)) | 1151 | (mapc 'landmark-print-distance-int landmark-directions)) |
| 1152 | 1152 | ||
| 1153 | 1153 | ||
| 1154 | ;;(setq direction 'lm-n) | 1154 | ;;(setq direction 'landmark-n) |
| 1155 | ;;(get 'lm-n 'lm-s) | 1155 | ;;(get 'landmark-n 'landmark-s) |
| 1156 | (defun lm-nslify-wts-int (direction) | 1156 | (defun landmark-nslify-wts-int (direction) |
| 1157 | (mapcar (lambda (target-direction) | 1157 | (mapcar (lambda (target-direction) |
| 1158 | (get direction target-direction)) | 1158 | (get direction target-direction)) |
| 1159 | lm-directions)) | 1159 | landmark-directions)) |
| 1160 | 1160 | ||
| 1161 | 1161 | ||
| 1162 | (defun lm-nslify-wts () | 1162 | (defun landmark-nslify-wts () |
| 1163 | (interactive) | 1163 | (interactive) |
| 1164 | (let ((l (apply 'append (mapcar 'lm-nslify-wts-int lm-directions)))) | 1164 | (let ((l (apply 'append (mapcar 'landmark-nslify-wts-int landmark-directions)))) |
| 1165 | (insert (format "set data_value WTS \n %s \n" l)) | 1165 | (insert (format "set data_value WTS \n %s \n" l)) |
| 1166 | (insert (format "/* max: %S min: %S */" | 1166 | (insert (format "/* max: %S min: %S */" |
| 1167 | (eval (cons 'max l)) (eval (cons 'min l)))))) | 1167 | (eval (cons 'max l)) (eval (cons 'min l)))))) |
| 1168 | 1168 | ||
| 1169 | (defun lm-print-wts-int (direction) | 1169 | (defun landmark-print-wts-int (direction) |
| 1170 | (mapc (lambda (target-direction) | 1170 | (mapc (lambda (target-direction) |
| 1171 | (insert (format "%S %S %S " | 1171 | (insert (format "%S %S %S " |
| 1172 | direction | 1172 | direction |
| 1173 | target-direction | 1173 | target-direction |
| 1174 | (get direction target-direction)))) | 1174 | (get direction target-direction)))) |
| 1175 | lm-directions) | 1175 | landmark-directions) |
| 1176 | (insert "\n")) | 1176 | (insert "\n")) |
| 1177 | 1177 | ||
| 1178 | (defun lm-print-wts () | 1178 | (defun landmark-print-wts () |
| 1179 | (interactive) | 1179 | (interactive) |
| 1180 | (with-current-buffer "*lm-wts*" | 1180 | (with-current-buffer "*landmark-wts*" |
| 1181 | (insert "==============================\n") | 1181 | (insert "==============================\n") |
| 1182 | (mapc 'lm-print-wts-int lm-directions))) | 1182 | (mapc 'landmark-print-wts-int landmark-directions))) |
| 1183 | 1183 | ||
| 1184 | (defun lm-print-moves (moves) | 1184 | (defun landmark-print-moves (moves) |
| 1185 | (interactive) | 1185 | (interactive) |
| 1186 | (with-current-buffer "*lm-moves*" | 1186 | (with-current-buffer "*landmark-moves*" |
| 1187 | (insert (format "%S\n" moves)))) | 1187 | (insert (format "%S\n" moves)))) |
| 1188 | 1188 | ||
| 1189 | 1189 | ||
| 1190 | (defun lm-print-y-s-noise-int (direction) | 1190 | (defun landmark-print-y-s-noise-int (direction) |
| 1191 | (insert (format "%S:lm-y %S, s %S, noise %S \n" | 1191 | (insert (format "%S:landmark-y %S, s %S, noise %S \n" |
| 1192 | (symbol-name direction) | 1192 | (symbol-name direction) |
| 1193 | (get direction 'y_t) | 1193 | (get direction 'y_t) |
| 1194 | (get direction 's) | 1194 | (get direction 's) |
| 1195 | (get direction 'noise) | 1195 | (get direction 'noise) |
| 1196 | ))) | 1196 | ))) |
| 1197 | 1197 | ||
| 1198 | (defun lm-print-y-s-noise () | 1198 | (defun landmark-print-y-s-noise () |
| 1199 | (interactive) | 1199 | (interactive) |
| 1200 | (with-current-buffer "*lm-y,s,noise*" | 1200 | (with-current-buffer "*landmark-y,s,noise*" |
| 1201 | (insert "==============================\n") | 1201 | (insert "==============================\n") |
| 1202 | (mapc 'lm-print-y-s-noise-int lm-directions))) | 1202 | (mapc 'landmark-print-y-s-noise-int landmark-directions))) |
| 1203 | 1203 | ||
| 1204 | (defun lm-print-smell-int (direction) | 1204 | (defun landmark-print-smell-int (direction) |
| 1205 | (insert (format "%S: smell: %S \n" | 1205 | (insert (format "%S: smell: %S \n" |
| 1206 | (symbol-name direction) | 1206 | (symbol-name direction) |
| 1207 | (get direction 'smell)))) | 1207 | (get direction 'smell)))) |
| 1208 | 1208 | ||
| 1209 | (defun lm-print-smell () | 1209 | (defun landmark-print-smell () |
| 1210 | (interactive) | 1210 | (interactive) |
| 1211 | (with-current-buffer "*lm-smell*" | 1211 | (with-current-buffer "*landmark-smell*" |
| 1212 | (insert "==============================\n") | 1212 | (insert "==============================\n") |
| 1213 | (insert (format "tree: %S \n" (get 'z 't))) | 1213 | (insert (format "tree: %S \n" (get 'z 't))) |
| 1214 | (mapc 'lm-print-smell-int lm-directions))) | 1214 | (mapc 'landmark-print-smell-int landmark-directions))) |
| 1215 | 1215 | ||
| 1216 | (defun lm-print-w0-int (direction) | 1216 | (defun landmark-print-w0-int (direction) |
| 1217 | (insert (format "%S: w0: %S \n" | 1217 | (insert (format "%S: w0: %S \n" |
| 1218 | (symbol-name direction) | 1218 | (symbol-name direction) |
| 1219 | (get direction 'w0)))) | 1219 | (get direction 'w0)))) |
| 1220 | 1220 | ||
| 1221 | (defun lm-print-w0 () | 1221 | (defun landmark-print-w0 () |
| 1222 | (interactive) | 1222 | (interactive) |
| 1223 | (with-current-buffer "*lm-w0*" | 1223 | (with-current-buffer "*landmark-w0*" |
| 1224 | (insert "==============================\n") | 1224 | (insert "==============================\n") |
| 1225 | (mapc 'lm-print-w0-int lm-directions))) | 1225 | (mapc 'landmark-print-w0-int landmark-directions))) |
| 1226 | 1226 | ||
| 1227 | (defun lm-blackbox () | 1227 | (defun landmark-blackbox () |
| 1228 | (with-current-buffer "*lm-blackbox*" | 1228 | (with-current-buffer "*landmark-blackbox*" |
| 1229 | (insert "==============================\n") | 1229 | (insert "==============================\n") |
| 1230 | (insert "I smell: ") | 1230 | (insert "I smell: ") |
| 1231 | (mapc (lambda (direction) | 1231 | (mapc (lambda (direction) |
| 1232 | (if (> (get direction 'smell) 0) | 1232 | (if (> (get direction 'smell) 0) |
| 1233 | (insert (format "%S " direction)))) | 1233 | (insert (format "%S " direction)))) |
| 1234 | lm-directions) | 1234 | landmark-directions) |
| 1235 | (insert "\n") | 1235 | (insert "\n") |
| 1236 | 1236 | ||
| 1237 | (insert "I move: ") | 1237 | (insert "I move: ") |
| 1238 | (mapc (lambda (direction) | 1238 | (mapc (lambda (direction) |
| 1239 | (if (> (get direction 'y_t) 0) | 1239 | (if (> (get direction 'y_t) 0) |
| 1240 | (insert (format "%S " direction)))) | 1240 | (insert (format "%S " direction)))) |
| 1241 | lm-directions) | 1241 | landmark-directions) |
| 1242 | (insert "\n") | 1242 | (insert "\n") |
| 1243 | (lm-print-wts-blackbox) | 1243 | (landmark-print-wts-blackbox) |
| 1244 | (insert (format "z_t-z_t-1: %S" (- (get 'z 't) (get 'z 't-1)))) | 1244 | (insert (format "z_t-z_t-1: %S" (- (get 'z 't) (get 'z 't-1)))) |
| 1245 | (lm-print-distance) | 1245 | (landmark-print-distance) |
| 1246 | (insert "\n"))) | 1246 | (insert "\n"))) |
| 1247 | 1247 | ||
| 1248 | (defun lm-print-wts-blackbox () | 1248 | (defun landmark-print-wts-blackbox () |
| 1249 | (interactive) | 1249 | (interactive) |
| 1250 | (mapc 'lm-print-wts-int lm-directions)) | 1250 | (mapc 'landmark-print-wts-int landmark-directions)) |
| 1251 | 1251 | ||
| 1252 | ;;;_ - learning parameters | 1252 | ;;;_ - learning parameters |
| 1253 | (defcustom lm-bound 0.005 | 1253 | (defcustom landmark-bound 0.005 |
| 1254 | "The maximum that w0j may be." | 1254 | "The maximum that w0j may be." |
| 1255 | :type 'number | 1255 | :type 'number |
| 1256 | :group 'lm) | 1256 | :group 'landmark) |
| 1257 | (defcustom lm-c 1.0 | 1257 | (defcustom landmark-c 1.0 |
| 1258 | "A factor applied to modulate the increase in wij. | 1258 | "A factor applied to modulate the increase in wij. |
| 1259 | Used in the function lm-update-normal-weights." | 1259 | Used in the function landmark-update-normal-weights." |
| 1260 | :type 'number | 1260 | :type 'number |
| 1261 | :group 'lm) | 1261 | :group 'landmark) |
| 1262 | (defcustom lm-c-naught 0.5 | 1262 | (defcustom landmark-c-naught 0.5 |
| 1263 | "A factor applied to modulate the increase in w0j. | 1263 | "A factor applied to modulate the increase in w0j. |
| 1264 | Used in the function lm-update-naught-weights." | 1264 | Used in the function landmark-update-naught-weights." |
| 1265 | :type 'number | 1265 | :type 'number |
| 1266 | :group 'lm) | 1266 | :group 'landmark) |
| 1267 | (defvar lm-initial-w0 0.0) | 1267 | (defvar landmark-initial-w0 0.0) |
| 1268 | (defvar lm-initial-wij 0.0) | 1268 | (defvar landmark-initial-wij 0.0) |
| 1269 | (defcustom lm-no-payoff 0 | 1269 | (defcustom landmark-no-payoff 0 |
| 1270 | "The amount of simulation cycles that have occurred with no movement. | 1270 | "The amount of simulation cycles that have occurred with no movement. |
| 1271 | Used to move the robot when he is stuck in a rut for some reason." | 1271 | Used to move the robot when he is stuck in a rut for some reason." |
| 1272 | :type 'integer | 1272 | :type 'integer |
| 1273 | :group 'lm) | 1273 | :group 'landmark) |
| 1274 | (defcustom lm-max-stall-time 2 | 1274 | (defcustom landmark-max-stall-time 2 |
| 1275 | "The maximum number of cycles that the robot can remain stuck in a place. | 1275 | "The maximum number of cycles that the robot can remain stuck in a place. |
| 1276 | After this limit is reached, lm-random-move is called to push him out of it." | 1276 | After this limit is reached, landmark-random-move is called to push him out of it." |
| 1277 | :type 'integer | 1277 | :type 'integer |
| 1278 | :group 'lm) | 1278 | :group 'landmark) |
| 1279 | 1279 | ||
| 1280 | 1280 | ||
| 1281 | ;;;_ + Randomizing functions | 1281 | ;;;_ + Randomizing functions |
| 1282 | ;;;_ - lm-flip-a-coin () | 1282 | ;;;_ - landmark-flip-a-coin () |
| 1283 | (defun lm-flip-a-coin () | 1283 | (defun landmark-flip-a-coin () |
| 1284 | (if (> (random 5000) 2500) | 1284 | (if (> (random 5000) 2500) |
| 1285 | -1 | 1285 | -1 |
| 1286 | 1)) | 1286 | 1)) |
| 1287 | ;;;_ : lm-very-small-random-number () | 1287 | ;;;_ : landmark-very-small-random-number () |
| 1288 | ;(defun lm-very-small-random-number () | 1288 | ;(defun landmark-very-small-random-number () |
| 1289 | ; (/ | 1289 | ; (/ |
| 1290 | ; (* (/ (random 900000) 900000.0) .0001))) | 1290 | ; (* (/ (random 900000) 900000.0) .0001))) |
| 1291 | ;;;_ : lm-randomize-weights-for (direction) | 1291 | ;;;_ : landmark-randomize-weights-for (direction) |
| 1292 | (defun lm-randomize-weights-for (direction) | 1292 | (defun landmark-randomize-weights-for (direction) |
| 1293 | (mapc (lambda (target-direction) | 1293 | (mapc (lambda (target-direction) |
| 1294 | (put direction | 1294 | (put direction |
| 1295 | target-direction | 1295 | target-direction |
| 1296 | (* (lm-flip-a-coin) (/ (random 10000) 10000.0)))) | 1296 | (* (landmark-flip-a-coin) (/ (random 10000) 10000.0)))) |
| 1297 | lm-directions)) | 1297 | landmark-directions)) |
| 1298 | ;;;_ : lm-noise () | 1298 | ;;;_ : landmark-noise () |
| 1299 | (defun lm-noise () | 1299 | (defun landmark-noise () |
| 1300 | (* (- (/ (random 30001) 15000.0) 1) lm-nvar)) | 1300 | (* (- (/ (random 30001) 15000.0) 1) landmark-nvar)) |
| 1301 | 1301 | ||
| 1302 | ;;;_ : lm-fix-weights-for (direction) | 1302 | ;;;_ : landmark-fix-weights-for (direction) |
| 1303 | (defun lm-fix-weights-for (direction) | 1303 | (defun landmark-fix-weights-for (direction) |
| 1304 | (mapc (lambda (target-direction) | 1304 | (mapc (lambda (target-direction) |
| 1305 | (put direction | 1305 | (put direction |
| 1306 | target-direction | 1306 | target-direction |
| 1307 | lm-initial-wij)) | 1307 | landmark-initial-wij)) |
| 1308 | lm-directions)) | 1308 | landmark-directions)) |
| 1309 | 1309 | ||
| 1310 | 1310 | ||
| 1311 | ;;;_ + Plotting functions | 1311 | ;;;_ + Plotting functions |
| 1312 | ;;;_ - lm-plot-internal (sym) | 1312 | ;;;_ - landmark-plot-internal (sym) |
| 1313 | (defun lm-plot-internal (sym) | 1313 | (defun landmark-plot-internal (sym) |
| 1314 | (lm-plot-square (lm-xy-to-index | 1314 | (landmark-plot-square (landmark-xy-to-index |
| 1315 | (get sym 'x) | 1315 | (get sym 'x) |
| 1316 | (get sym 'y)) | 1316 | (get sym 'y)) |
| 1317 | (get sym 'sym))) | 1317 | (get sym 'sym))) |
| 1318 | ;;;_ - lm-plot-landmarks () | 1318 | ;;;_ - landmark-plot-landmarks () |
| 1319 | (defun lm-plot-landmarks () | 1319 | (defun landmark-plot-landmarks () |
| 1320 | (setq lm-cx (/ lm-board-width 2)) | 1320 | (setq landmark-cx (/ landmark-board-width 2)) |
| 1321 | (setq lm-cy (/ lm-board-height 2)) | 1321 | (setq landmark-cy (/ landmark-board-height 2)) |
| 1322 | 1322 | ||
| 1323 | (put 'lm-n 'x lm-cx) | 1323 | (put 'landmark-n 'x landmark-cx) |
| 1324 | (put 'lm-n 'y 1) | 1324 | (put 'landmark-n 'y 1) |
| 1325 | (put 'lm-n 'sym 2) | 1325 | (put 'landmark-n 'sym 2) |
| 1326 | 1326 | ||
| 1327 | (put 'lm-tree 'x lm-cx) | 1327 | (put 'landmark-tree 'x landmark-cx) |
| 1328 | (put 'lm-tree 'y lm-cy) | 1328 | (put 'landmark-tree 'y landmark-cy) |
| 1329 | (put 'lm-tree 'sym 6) | 1329 | (put 'landmark-tree 'sym 6) |
| 1330 | 1330 | ||
| 1331 | (put 'lm-s 'x lm-cx) | 1331 | (put 'landmark-s 'x landmark-cx) |
| 1332 | (put 'lm-s 'y lm-board-height) | 1332 | (put 'landmark-s 'y landmark-board-height) |
| 1333 | (put 'lm-s 'sym 3) | 1333 | (put 'landmark-s 'sym 3) |
| 1334 | 1334 | ||
| 1335 | (put 'lm-w 'x 1) | 1335 | (put 'landmark-w 'x 1) |
| 1336 | (put 'lm-w 'y (/ lm-board-height 2)) | 1336 | (put 'landmark-w 'y (/ landmark-board-height 2)) |
| 1337 | (put 'lm-w 'sym 5) | 1337 | (put 'landmark-w 'sym 5) |
| 1338 | 1338 | ||
| 1339 | (put 'lm-e 'x lm-board-width) | 1339 | (put 'landmark-e 'x landmark-board-width) |
| 1340 | (put 'lm-e 'y (/ lm-board-height 2)) | 1340 | (put 'landmark-e 'y (/ landmark-board-height 2)) |
| 1341 | (put 'lm-e 'sym 4) | 1341 | (put 'landmark-e 'sym 4) |
| 1342 | 1342 | ||
| 1343 | (mapc 'lm-plot-internal '(lm-n lm-s lm-e lm-w lm-tree))) | 1343 | (mapc 'landmark-plot-internal '(landmark-n landmark-s landmark-e landmark-w landmark-tree))) |
| 1344 | 1344 | ||
| 1345 | 1345 | ||
| 1346 | 1346 | ||
| @@ -1357,9 +1357,9 @@ After this limit is reached, lm-random-move is called to push him out of it." | |||
| 1357 | (defun calc-distance-of-robot-from (direction) | 1357 | (defun calc-distance-of-robot-from (direction) |
| 1358 | (put direction 'distance | 1358 | (put direction 'distance |
| 1359 | (distance (get direction 'x) | 1359 | (distance (get direction 'x) |
| 1360 | (lm-index-to-x (lm-point-square)) | 1360 | (landmark-index-to-x (landmark-point-square)) |
| 1361 | (get direction 'y) | 1361 | (get direction 'y) |
| 1362 | (lm-index-to-y (lm-point-square))))) | 1362 | (landmark-index-to-y (landmark-point-square))))) |
| 1363 | 1363 | ||
| 1364 | ;;;_ - calc-smell-internal (sym) | 1364 | ;;;_ - calc-smell-internal (sym) |
| 1365 | (defun calc-smell-internal (sym) | 1365 | (defun calc-smell-internal (sym) |
| @@ -1371,269 +1371,259 @@ After this limit is reached, lm-random-move is called to push him out of it." | |||
| 1371 | 1371 | ||
| 1372 | 1372 | ||
| 1373 | ;;;_ + Learning (neural) functions | 1373 | ;;;_ + Learning (neural) functions |
| 1374 | (defun lm-f (x) | 1374 | (defun landmark-f (x) |
| 1375 | (cond | 1375 | (cond |
| 1376 | ((> x lm-bound) lm-bound) | 1376 | ((> x landmark-bound) landmark-bound) |
| 1377 | ((< x 0.0) 0.0) | 1377 | ((< x 0.0) 0.0) |
| 1378 | (t x))) | 1378 | (t x))) |
| 1379 | 1379 | ||
| 1380 | (defun lm-y (direction) | 1380 | (defun landmark-y (direction) |
| 1381 | (let ((noise (put direction 'noise (lm-noise)))) | 1381 | (let ((noise (put direction 'noise (landmark-noise)))) |
| 1382 | (put direction 'y_t | 1382 | (put direction 'y_t |
| 1383 | (if (> (get direction 's) 0.0) | 1383 | (if (> (get direction 's) 0.0) |
| 1384 | 1.0 | 1384 | 1.0 |
| 1385 | 0.0)))) | 1385 | 0.0)))) |
| 1386 | 1386 | ||
| 1387 | (defun lm-update-normal-weights (direction) | 1387 | (defun landmark-update-normal-weights (direction) |
| 1388 | (mapc (lambda (target-direction) | 1388 | (mapc (lambda (target-direction) |
| 1389 | (put direction target-direction | 1389 | (put direction target-direction |
| 1390 | (+ | 1390 | (+ |
| 1391 | (get direction target-direction) | 1391 | (get direction target-direction) |
| 1392 | (* lm-c | 1392 | (* landmark-c |
| 1393 | (- (get 'z 't) (get 'z 't-1)) | 1393 | (- (get 'z 't) (get 'z 't-1)) |
| 1394 | (get target-direction 'y_t) | 1394 | (get target-direction 'y_t) |
| 1395 | (get direction 'smell))))) | 1395 | (get direction 'smell))))) |
| 1396 | lm-directions)) | 1396 | landmark-directions)) |
| 1397 | 1397 | ||
| 1398 | (defun lm-update-naught-weights (direction) | 1398 | (defun landmark-update-naught-weights (direction) |
| 1399 | (mapc (lambda (target-direction) | 1399 | (mapc (lambda (target-direction) |
| 1400 | (put direction 'w0 | 1400 | (put direction 'w0 |
| 1401 | (lm-f | 1401 | (landmark-f |
| 1402 | (+ | 1402 | (+ |
| 1403 | (get direction 'w0) | 1403 | (get direction 'w0) |
| 1404 | (* lm-c-naught | 1404 | (* landmark-c-naught |
| 1405 | (- (get 'z 't) (get 'z 't-1)) | 1405 | (- (get 'z 't) (get 'z 't-1)) |
| 1406 | (get direction 'y_t)))))) | 1406 | (get direction 'y_t)))))) |
| 1407 | lm-directions)) | 1407 | landmark-directions)) |
| 1408 | 1408 | ||
| 1409 | 1409 | ||
| 1410 | ;;;_ + Statistics gathering and creating functions | 1410 | ;;;_ + Statistics gathering and creating functions |
| 1411 | 1411 | ||
| 1412 | (defun lm-calc-current-smells () | 1412 | (defun landmark-calc-current-smells () |
| 1413 | (mapc (lambda (direction) | 1413 | (mapc (lambda (direction) |
| 1414 | (put direction 'smell (calc-smell-internal direction))) | 1414 | (put direction 'smell (calc-smell-internal direction))) |
| 1415 | lm-directions)) | 1415 | landmark-directions)) |
| 1416 | 1416 | ||
| 1417 | (defun lm-calc-payoff () | 1417 | (defun landmark-calc-payoff () |
| 1418 | (put 'z 't-1 (get 'z 't)) | 1418 | (put 'z 't-1 (get 'z 't)) |
| 1419 | (put 'z 't (calc-smell-internal 'lm-tree)) | 1419 | (put 'z 't (calc-smell-internal 'landmark-tree)) |
| 1420 | (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) | 1420 | (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) |
| 1421 | (incf lm-no-payoff) | 1421 | (incf landmark-no-payoff) |
| 1422 | (setf lm-no-payoff 0))) | 1422 | (setf landmark-no-payoff 0))) |
| 1423 | 1423 | ||
| 1424 | (defun lm-store-old-y_t () | 1424 | (defun landmark-store-old-y_t () |
| 1425 | (mapc (lambda (direction) | 1425 | (mapc (lambda (direction) |
| 1426 | (put direction 'y_t-1 (get direction 'y_t))) | 1426 | (put direction 'y_t-1 (get direction 'y_t))) |
| 1427 | lm-directions)) | 1427 | landmark-directions)) |
| 1428 | 1428 | ||
| 1429 | 1429 | ||
| 1430 | ;;;_ + Functions to move robot | 1430 | ;;;_ + Functions to move robot |
| 1431 | 1431 | ||
| 1432 | (defun lm-confidence-for (target-direction) | 1432 | (defun landmark-confidence-for (target-direction) |
| 1433 | (apply '+ | 1433 | (apply '+ |
| 1434 | (get target-direction 'w0) | 1434 | (get target-direction 'w0) |
| 1435 | (mapcar (lambda (direction) | 1435 | (mapcar (lambda (direction) |
| 1436 | (* | 1436 | (* |
| 1437 | (get direction target-direction) | 1437 | (get direction target-direction) |
| 1438 | (get direction 'smell))) | 1438 | (get direction 'smell))) |
| 1439 | lm-directions))) | 1439 | landmark-directions))) |
| 1440 | 1440 | ||
| 1441 | 1441 | ||
| 1442 | (defun lm-calc-confidences () | 1442 | (defun landmark-calc-confidences () |
| 1443 | (mapc (lambda (direction) | 1443 | (mapc (lambda (direction) |
| 1444 | (put direction 's (lm-confidence-for direction))) | 1444 | (put direction 's (landmark-confidence-for direction))) |
| 1445 | lm-directions)) | 1445 | landmark-directions)) |
| 1446 | 1446 | ||
| 1447 | (defun lm-move () | 1447 | (defun landmark-move () |
| 1448 | (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0)) | 1448 | (if (and (= (get 'landmark-n 'y_t) 1.0) (= (get 'landmark-s 'y_t) 1.0)) |
| 1449 | (progn | 1449 | (progn |
| 1450 | (mapc (lambda (dir) (put dir 'y_t 0)) lm-ns) | 1450 | (mapc (lambda (dir) (put dir 'y_t 0)) landmark-ns) |
| 1451 | (if lm-debug | 1451 | (if landmark-debug |
| 1452 | (message "n-s normalization.")))) | 1452 | (message "n-s normalization.")))) |
| 1453 | (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0)) | 1453 | (if (and (= (get 'landmark-w 'y_t) 1.0) (= (get 'landmark-e 'y_t) 1.0)) |
| 1454 | (progn | 1454 | (progn |
| 1455 | (mapc (lambda (dir) (put dir 'y_t 0)) lm-ew) | 1455 | (mapc (lambda (dir) (put dir 'y_t 0)) landmark-ew) |
| 1456 | (if lm-debug | 1456 | (if landmark-debug |
| 1457 | (message "e-w normalization")))) | 1457 | (message "e-w normalization")))) |
| 1458 | 1458 | ||
| 1459 | (mapc (lambda (pair) | 1459 | (mapc (lambda (pair) |
| 1460 | (if (> (get (car pair) 'y_t) 0) | 1460 | (if (> (get (car pair) 'y_t) 0) |
| 1461 | (funcall (car (cdr pair))))) | 1461 | (funcall (car (cdr pair))))) |
| 1462 | '( | 1462 | '( |
| 1463 | (lm-n lm-move-up) | 1463 | (landmark-n landmark-move-up) |
| 1464 | (lm-s lm-move-down) | 1464 | (landmark-s landmark-move-down) |
| 1465 | (lm-e forward-char) | 1465 | (landmark-e forward-char) |
| 1466 | (lm-w backward-char))) | 1466 | (landmark-w backward-char))) |
| 1467 | (lm-plot-square (lm-point-square) 1) | 1467 | (landmark-plot-square (landmark-point-square) 1) |
| 1468 | (incf lm-number-of-moves) | 1468 | (incf landmark-number-of-moves) |
| 1469 | (if lm-output-moves | 1469 | (if landmark-output-moves |
| 1470 | (message "Moves made: %d" lm-number-of-moves))) | 1470 | (message "Moves made: %d" landmark-number-of-moves))) |
| 1471 | 1471 | ||
| 1472 | 1472 | ||
| 1473 | (defun lm-random-move () | 1473 | (defun landmark-random-move () |
| 1474 | (mapc | 1474 | (mapc |
| 1475 | (lambda (direction) (put direction 'y_t 0)) | 1475 | (lambda (direction) (put direction 'y_t 0)) |
| 1476 | lm-directions) | 1476 | landmark-directions) |
| 1477 | (dolist (direction (nth (random 8) lm-8-directions)) | 1477 | (dolist (direction (nth (random 8) landmark-8-directions)) |
| 1478 | (put direction 'y_t 1.0)) | 1478 | (put direction 'y_t 1.0)) |
| 1479 | (lm-move)) | 1479 | (landmark-move)) |
| 1480 | 1480 | ||
| 1481 | (defun lm-amble-robot () | 1481 | (defun landmark-amble-robot () |
| 1482 | (interactive) | 1482 | (interactive) |
| 1483 | (while (> (calc-distance-of-robot-from 'lm-tree) 0) | 1483 | (while (> (calc-distance-of-robot-from 'landmark-tree) 0) |
| 1484 | 1484 | ||
| 1485 | (lm-store-old-y_t) | 1485 | (landmark-store-old-y_t) |
| 1486 | (lm-calc-current-smells) | 1486 | (landmark-calc-current-smells) |
| 1487 | 1487 | ||
| 1488 | (if (> lm-no-payoff lm-max-stall-time) | 1488 | (if (> landmark-no-payoff landmark-max-stall-time) |
| 1489 | (lm-random-move) | 1489 | (landmark-random-move) |
| 1490 | (progn | 1490 | (progn |
| 1491 | (lm-calc-confidences) | 1491 | (landmark-calc-confidences) |
| 1492 | (mapc 'lm-y lm-directions) | 1492 | (mapc 'landmark-y landmark-directions) |
| 1493 | (lm-move))) | 1493 | (landmark-move))) |
| 1494 | 1494 | ||
| 1495 | (lm-calc-payoff) | 1495 | (landmark-calc-payoff) |
| 1496 | 1496 | ||
| 1497 | (mapc 'lm-update-normal-weights lm-directions) | 1497 | (mapc 'landmark-update-normal-weights landmark-directions) |
| 1498 | (mapc 'lm-update-naught-weights lm-directions) | 1498 | (mapc 'landmark-update-naught-weights landmark-directions) |
| 1499 | (if lm-debug | 1499 | (if landmark-debug |
| 1500 | (lm-weights-debug))) | 1500 | (landmark-weights-debug))) |
| 1501 | (lm-terminate-game nil)) | 1501 | (landmark-terminate-game nil)) |
| 1502 | 1502 | ||
| 1503 | 1503 | ||
| 1504 | ;;;_ - lm-start-robot () | 1504 | ;;;_ - landmark-start-robot () |
| 1505 | (defun lm-start-robot () | 1505 | (defun landmark-start-robot () |
| 1506 | "Signal to the Lm program that you have played. | 1506 | "Signal to the Landmark program that you have played. |
| 1507 | You must have put the cursor on the square where you want to play. | 1507 | You must have put the cursor on the square where you want to play. |
| 1508 | If the game is finished, this command requests for another game." | 1508 | If the game is finished, this command requests for another game." |
| 1509 | (interactive) | 1509 | (interactive) |
| 1510 | (lm-switch-to-window) | 1510 | (landmark-switch-to-window) |
| 1511 | (cond | 1511 | (cond |
| 1512 | (lm-emacs-is-computing | 1512 | (landmark-emacs-is-computing |
| 1513 | (lm-crash-game)) | 1513 | (landmark-crash-game)) |
| 1514 | ((not lm-game-in-progress) | 1514 | ((not landmark-game-in-progress) |
| 1515 | (lm-prompt-for-other-game)) | 1515 | (landmark-prompt-for-other-game)) |
| 1516 | (t | 1516 | (t |
| 1517 | (let (square score) | 1517 | (let (square score) |
| 1518 | (setq square (lm-point-square)) | 1518 | (setq square (landmark-point-square)) |
| 1519 | (cond ((null square) | 1519 | (cond ((null square) |
| 1520 | (error "Your point is not on a square. Retry!")) | 1520 | (error "Your point is not on a square. Retry!")) |
| 1521 | ((not (zerop (aref lm-board square))) | 1521 | ((not (zerop (aref landmark-board square))) |
| 1522 | (error "Your point is not on a free square. Retry!")) | 1522 | (error "Your point is not on a free square. Retry!")) |
| 1523 | (t | 1523 | (t |
| 1524 | (progn | 1524 | (progn |
| 1525 | (lm-plot-square square 1) | 1525 | (landmark-plot-square square 1) |
| 1526 | 1526 | ||
| 1527 | (lm-store-old-y_t) | 1527 | (landmark-store-old-y_t) |
| 1528 | (lm-calc-current-smells) | 1528 | (landmark-calc-current-smells) |
| 1529 | (put 'z 't (calc-smell-internal 'lm-tree)) | 1529 | (put 'z 't (calc-smell-internal 'landmark-tree)) |
| 1530 | 1530 | ||
| 1531 | (lm-random-move) | 1531 | (landmark-random-move) |
| 1532 | 1532 | ||
| 1533 | (lm-calc-payoff) | 1533 | (landmark-calc-payoff) |
| 1534 | 1534 | ||
| 1535 | (mapc 'lm-update-normal-weights lm-directions) | 1535 | (mapc 'landmark-update-normal-weights landmark-directions) |
| 1536 | (mapc 'lm-update-naught-weights lm-directions) | 1536 | (mapc 'landmark-update-naught-weights landmark-directions) |
| 1537 | (lm-amble-robot) | 1537 | (landmark-amble-robot) |
| 1538 | ))))))) | 1538 | ))))))) |
| 1539 | 1539 | ||
| 1540 | 1540 | ||
| 1541 | ;;;_ + Misc functions | 1541 | ;;;_ + Misc functions |
| 1542 | ;;;_ - lm-init (auto-start save-weights) | 1542 | ;;;_ - landmark-init (auto-start save-weights) |
| 1543 | (defvar lm-tree-r "") | 1543 | (defvar landmark-tree-r "") |
| 1544 | 1544 | ||
| 1545 | (defun lm-init (auto-start save-weights) | 1545 | (defun landmark-init (auto-start save-weights) |
| 1546 | 1546 | ||
| 1547 | (setq lm-number-of-moves 0) | 1547 | (setq landmark-number-of-moves 0) |
| 1548 | 1548 | ||
| 1549 | (lm-plot-landmarks) | 1549 | (landmark-plot-landmarks) |
| 1550 | 1550 | ||
| 1551 | (if lm-debug | 1551 | (if landmark-debug |
| 1552 | (save-current-buffer | 1552 | (save-current-buffer |
| 1553 | (set-buffer (get-buffer-create "*lm-w0*")) | 1553 | (set-buffer (get-buffer-create "*landmark-w0*")) |
| 1554 | (erase-buffer) | 1554 | (erase-buffer) |
| 1555 | (set-buffer (get-buffer-create "*lm-moves*")) | 1555 | (set-buffer (get-buffer-create "*landmark-moves*")) |
| 1556 | (set-buffer (get-buffer-create "*lm-wts*")) | 1556 | (set-buffer (get-buffer-create "*landmark-wts*")) |
| 1557 | (erase-buffer) | 1557 | (erase-buffer) |
| 1558 | (set-buffer (get-buffer-create "*lm-y,s,noise*")) | 1558 | (set-buffer (get-buffer-create "*landmark-y,s,noise*")) |
| 1559 | (erase-buffer) | 1559 | (erase-buffer) |
| 1560 | (set-buffer (get-buffer-create "*lm-smell*")) | 1560 | (set-buffer (get-buffer-create "*landmark-smell*")) |
| 1561 | (erase-buffer) | 1561 | (erase-buffer) |
| 1562 | (set-buffer (get-buffer-create "*lm-blackbox*")) | 1562 | (set-buffer (get-buffer-create "*landmark-blackbox*")) |
| 1563 | (erase-buffer) | 1563 | (erase-buffer) |
| 1564 | (set-buffer (get-buffer-create "*lm-distance*")) | 1564 | (set-buffer (get-buffer-create "*landmark-distance*")) |
| 1565 | (erase-buffer))) | 1565 | (erase-buffer))) |
| 1566 | 1566 | ||
| 1567 | 1567 | ||
| 1568 | (lm-set-landmark-signal-strengths) | 1568 | (landmark-set-landmark-signal-strengths) |
| 1569 | 1569 | ||
| 1570 | (dolist (direction lm-directions) | 1570 | (dolist (direction landmark-directions) |
| 1571 | (put direction 'y_t 0.0)) | 1571 | (put direction 'y_t 0.0)) |
| 1572 | 1572 | ||
| 1573 | (if (not save-weights) | 1573 | (if (not save-weights) |
| 1574 | (progn | 1574 | (progn |
| 1575 | (mapc 'lm-fix-weights-for lm-directions) | 1575 | (mapc 'landmark-fix-weights-for landmark-directions) |
| 1576 | (dolist (direction lm-directions) | 1576 | (dolist (direction landmark-directions) |
| 1577 | (put direction 'w0 lm-initial-w0))) | 1577 | (put direction 'w0 landmark-initial-w0))) |
| 1578 | (message "Weights preserved for this run.")) | 1578 | (message "Weights preserved for this run.")) |
| 1579 | 1579 | ||
| 1580 | (if auto-start | 1580 | (if auto-start |
| 1581 | (progn | 1581 | (progn |
| 1582 | (lm-goto-xy (1+ (random lm-board-width)) (1+ (random lm-board-height))) | 1582 | (landmark-goto-xy (1+ (random landmark-board-width)) (1+ (random landmark-board-height))) |
| 1583 | (lm-start-robot)))) | 1583 | (landmark-start-robot)))) |
| 1584 | 1584 | ||
| 1585 | 1585 | ||
| 1586 | ;;;_ - something which doesn't work | 1586 | ;;;_ - something which doesn't work |
| 1587 | ; no-a-worka!! | 1587 | ; no-a-worka!! |
| 1588 | ;(defum lm-sum-list (list) | 1588 | ;(defum landmark-sum-list (list) |
| 1589 | ; (if (> (length list) 0) | 1589 | ; (if (> (length list) 0) |
| 1590 | ; (+ (car list) (lm-sum-list (cdr list))) | 1590 | ; (+ (car list) (landmark-sum-list (cdr list))) |
| 1591 | ; 0)) | 1591 | ; 0)) |
| 1592 | ; this a worka! | 1592 | ; this a worka! |
| 1593 | ; (eval (cons '+ list)) | 1593 | ; (eval (cons '+ list)) |
| 1594 | ;;;_ - lm-set-landmark-signal-strengths () | 1594 | ;;;_ - landmark-set-landmark-signal-strengths () |
| 1595 | ;;; on a screen higher than wide, I noticed that the robot would amble | 1595 | ;;; on a screen higher than wide, I noticed that the robot would amble |
| 1596 | ;;; left and right and not move forward. examining *lm-blackbox* | 1596 | ;;; left and right and not move forward. examining *landmark-blackbox* |
| 1597 | ;;; revealed that there was no scent from the north and south | 1597 | ;;; revealed that there was no scent from the north and south |
| 1598 | ;;; landmarks, hence, they need less factoring down of the effect of | 1598 | ;;; landmarks, hence, they need less factoring down of the effect of |
| 1599 | ;;; distance on scent. | 1599 | ;;; distance on scent. |
| 1600 | 1600 | ||
| 1601 | (defun lm-set-landmark-signal-strengths () | 1601 | (defun landmark-set-landmark-signal-strengths () |
| 1602 | 1602 | (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5)) | |
| 1603 | (setq lm-tree-r (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5)) | ||
| 1604 | |||
| 1605 | (mapc (lambda (direction) | 1603 | (mapc (lambda (direction) |
| 1606 | (put direction 'r (* lm-cx 1.1))) | 1604 | (put direction 'r (* landmark-cx 1.1))) |
| 1607 | lm-ew) | 1605 | landmark-ew) |
| 1608 | (mapc (lambda (direction) | 1606 | (mapc (lambda (direction) |
| 1609 | (put direction 'r (* lm-cy 1.1))) | 1607 | (put direction 'r (* landmark-cy 1.1))) |
| 1610 | lm-ns) | 1608 | landmark-ns) |
| 1611 | (put 'lm-tree 'r lm-tree-r)) | 1609 | (put 'landmark-tree 'r landmark-tree-r)) |
| 1612 | 1610 | ||
| 1613 | 1611 | ||
| 1614 | ;;;_ + lm-test-run () | 1612 | ;;;_ + landmark-test-run () |
| 1615 | 1613 | ||
| 1616 | ;;;###autoload | 1614 | ;;;###autoload |
| 1617 | (defalias 'landmark-repeat 'lm-test-run) | 1615 | (defalias 'landmark-repeat 'landmark-test-run) |
| 1618 | ;;;###autoload | 1616 | ;;;###autoload |
| 1619 | (defun lm-test-run () | 1617 | (defun landmark-test-run () |
| 1620 | "Run 100 Lm games, each time saving the weights from the previous game." | 1618 | "Run 100 Landmark games, each time saving the weights from the previous game." |
| 1621 | (interactive) | 1619 | (interactive) |
| 1622 | 1620 | (landmark 1) | |
| 1623 | (lm 1) | ||
| 1624 | |||
| 1625 | (dotimes (scratch-var 100) | 1621 | (dotimes (scratch-var 100) |
| 1622 | (landmark 2))) | ||
| 1626 | 1623 | ||
| 1627 | (lm 2))) | ||
| 1628 | |||
| 1629 | |||
| 1630 | ;;;_ + lm: The function you invoke to play | ||
| 1631 | |||
| 1632 | ;;;###autoload | ||
| 1633 | (defalias 'landmark 'lm) | ||
| 1634 | ;;;###autoload | 1624 | ;;;###autoload |
| 1635 | (defun lm (parg) | 1625 | (defun landmark (parg) |
| 1636 | "Start or resume an Lm game. | 1626 | "Start or resume an Landmark game. |
| 1637 | If a game is in progress, this command allows you to resume it. | 1627 | If a game is in progress, this command allows you to resume it. |
| 1638 | Here is the relation between prefix args and game options: | 1628 | Here is the relation between prefix args and game options: |
| 1639 | 1629 | ||
| @@ -1644,37 +1634,37 @@ none / 1 | yes | no | |||
| 1644 | 3 | no | yes | 1634 | 3 | no | yes |
| 1645 | 4 | no | no | 1635 | 4 | no | no |
| 1646 | 1636 | ||
| 1647 | You start by moving to a square and typing \\[lm-start-robot], | 1637 | You start by moving to a square and typing \\[landmark-start-robot], |
| 1648 | if you did not use a prefix arg to ask for automatic start. | 1638 | if you did not use a prefix arg to ask for automatic start. |
| 1649 | Use \\[describe-mode] for more info." | 1639 | Use \\[describe-mode] for more info." |
| 1650 | (interactive "p") | 1640 | (interactive "p") |
| 1651 | 1641 | ||
| 1652 | (setf lm-n nil lm-m nil) | 1642 | (setf landmark-n nil landmark-m nil) |
| 1653 | (lm-switch-to-window) | 1643 | (landmark-switch-to-window) |
| 1654 | (cond | 1644 | (cond |
| 1655 | (lm-emacs-is-computing | 1645 | (landmark-emacs-is-computing |
| 1656 | (lm-crash-game)) | 1646 | (landmark-crash-game)) |
| 1657 | ((or (not lm-game-in-progress) | 1647 | ((or (not landmark-game-in-progress) |
| 1658 | (<= lm-number-of-moves 2)) | 1648 | (<= landmark-number-of-moves 2)) |
| 1659 | (let ((max-width (lm-max-width)) | 1649 | (let ((max-width (landmark-max-width)) |
| 1660 | (max-height (lm-max-height))) | 1650 | (max-height (landmark-max-height))) |
| 1661 | (or lm-n (setq lm-n max-width)) | 1651 | (or landmark-n (setq landmark-n max-width)) |
| 1662 | (or lm-m (setq lm-m max-height)) | 1652 | (or landmark-m (setq landmark-m max-height)) |
| 1663 | (cond ((< lm-n 1) | 1653 | (cond ((< landmark-n 1) |
| 1664 | (error "I need at least 1 column")) | 1654 | (error "I need at least 1 column")) |
| 1665 | ((< lm-m 1) | 1655 | ((< landmark-m 1) |
| 1666 | (error "I need at least 1 row")) | 1656 | (error "I need at least 1 row")) |
| 1667 | ((> lm-n max-width) | 1657 | ((> landmark-n max-width) |
| 1668 | (error "I cannot display %d columns in that window" lm-n))) | 1658 | (error "I cannot display %d columns in that window" landmark-n))) |
| 1669 | (if (and (> lm-m max-height) | 1659 | (if (and (> landmark-m max-height) |
| 1670 | (not (eq lm-m lm-saved-board-height)) | 1660 | (not (eq landmark-m landmark-saved-board-height)) |
| 1671 | ;; Use EQ because SAVED-BOARD-HEIGHT may be nil | 1661 | ;; Use EQ because SAVED-BOARD-HEIGHT may be nil |
| 1672 | (not (y-or-n-p (format "Do you really want %d rows? " lm-m)))) | 1662 | (not (y-or-n-p (format "Do you really want %d rows? " landmark-m)))) |
| 1673 | (setq lm-m max-height))) | 1663 | (setq landmark-m max-height))) |
| 1674 | (if lm-one-moment-please | 1664 | (if landmark-one-moment-please |
| 1675 | (message "One moment, please...")) | 1665 | (message "One moment, please...")) |
| 1676 | (lm-start-game lm-n lm-m) | 1666 | (landmark-start-game landmark-n landmark-m) |
| 1677 | (eval (cons 'lm-init | 1667 | (eval (cons 'landmark-init |
| 1678 | (cond | 1668 | (cond |
| 1679 | ((= parg 1) '(t nil)) | 1669 | ((= parg 1) '(t nil)) |
| 1680 | ((= parg 2) '(t t)) | 1670 | ((= parg 2) '(t t)) |