Mercurial > emacs

comparison lisp/play/landmark.el @ 112427:bc872de587fa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* play/landmark.el: Change `lm-' prefix to `landmark-' (Bug#7672). (lm): Rename to landmark. (lm-test-run): Rename to landmark-test-run.
author Chong Yidong <cyd@stupidchicken.com>
date Sat, 22 Jan 2011 15:12:51 -0500
parents 417b1e4d63cd
children
comparison
equal deleted inserted replaced
112426:59f7ce1a78c6 112427:bc872de587fa
8 ;; Keywords: games, gomoku, neural network, adaptive search, chemotaxis 8 ;; Keywords: games, gomoku, neural network, adaptive search, chemotaxis
9 9
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.
17 17
18 ;; GNU Emacs is free software: you can redistribute it and/or modify 18 ;; GNU Emacs is free software: you can redistribute it and/or modify
28 ;; You should have received a copy of the GNU General Public License 28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 29 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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
37 ;; brain are adjusted to encourage this odor-driven behavior in the 37 ;; brain are adjusted to encourage this odor-driven behavior in the
38 ;; future. If the smell of the tree decreases, the robots weights are 38 ;; future. If the smell of the tree decreases, the robots weights are
51 ;; move in a net direction can produce gross credit assignment. for 51 ;; move in a net direction can produce gross credit assignment. for
52 ;; example, if moving south will produce positive payoff, then, if in 52 ;; example, if moving south will produce positive payoff, then, if in
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
60 (eval-when-compile (require 'cl)) 60 (eval-when-compile (require 'cl))
61 61
62 ;;;_* From Gomoku 62 ;;;_* From Gomoku
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.
72 72
73 ;; The board is a rectangular grid. We code empty squares with 0, X's with 1 73 ;; The board is a rectangular grid. We code empty squares with 0, X's with 1
74 ;; and O's with 6. The rectangle is recorded in a one dimensional vector 74 ;; and O's with 6. The rectangle is recorded in a one dimensional vector
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
274 ;; The key point point about the algorithm is that, rather than considering 274 ;; The key point point about the algorithm is that, rather than considering
275 ;; the board as just a set of squares, we prefer to see it as a "space" of 275 ;; the board as just a set of squares, we prefer to see it as a "space" of
292 ;; because playing in that square is playing in all its containing qtuples at 292 ;; because playing in that square is playing in all its containing qtuples at
293 ;; once. And it is that function which takes into account the internesting of 293 ;; once. And it is that function which takes into account the internesting of
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
301 301
302 ;; Here are the scores of the nine "non-polluted" configurations. Tuning 302 ;; Here are the scores of the nine "non-polluted" configurations. Tuning
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.
312 (XXXXscore 100000) ; Score of a qtuple containing four X's. 312 (XXXXscore 100000) ; Score of a qtuple containing four X's.
313 (Oscore 35) ; Score of a qtuple containing one O. 313 (Oscore 35) ; Score of a qtuple containing one O.
336 336
337 337
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
345 OOOOscore 0 0 0 0 0 345 OOOOscore 0 0 0 0 0
346 0)) 346 0))
352 ;; qtuple, thus to be a winning move. Similarly, the only way for a square to 352 ;; qtuple, thus to be a winning move. Similarly, the only way for a square to
353 ;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX" 353 ;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX"
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
370 ;; up future searches, we set the score of padding or occupied squares 370 ;; up future searches, we set the score of padding or occupied squares
371 ;; to -1 whenever we meet them. 371 ;; to -1 whenever we meet them.
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)))
395 (setq square (1+ square))) ; try next square 395 (setq square (1+ square))) ; try next square
396 best-square)) 396 best-square))
405 ;; consider squares at less than 5 squares from one side. We speed this up by 405 ;; consider squares at less than 5 squares from one side. We speed this up by
406 ;; taking symmetry into account. 406 ;; taking symmetry into account.
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
435 ;; would have been square and not rectangular ! 435 ;; would have been square and not rectangular !
436 ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U 436 ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U
438 ;; board may well be less than 8 by 8 ! 438 ;; board may well be less than 8 by 8 !
439 (setq i 1) 439 (setq i 1)
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
483 ;; We do not provide functions for computing the SCORE-TABLE given the 483 ;; We do not provide functions for computing the SCORE-TABLE given the
484 ;; contents of the BOARD. This would involve heavy nested loops, with time 484 ;; contents of the BOARD. This would involve heavy nested loops, with time
485 ;; proportional to the size of the board. It is better to update the 485 ;; proportional to the size of the board. It is better to update the
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
493 ;; directions and then calling update-score-in-direction. 493 ;; directions and then calling update-score-in-direction.
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."
519 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well 519 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well
520 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that 520 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that
521 ;; DX,DY direction. 521 ;; DX,DY direction.
522 (cond 522 (cond
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)))
530 ;; Compute the contents of the first qtuple: 530 ;; Compute the contents of the first qtuple:
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 ;;;
556 ;;; GAME CONTROL. 556 ;;; GAME CONTROL.
557 ;;; 557 ;;;
559 ;; Several variables are used to monitor a game, including a GAME-HISTORY (the 559 ;; Several variables are used to monitor a game, including a GAME-HISTORY (the
560 ;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back 560 ;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back
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) ?.)
889 ((= value 2) ?N) 889 ((= value 2) ?N)
890 ((= value 3) ?S) 890 ((= value 3) ?S)
899 mouse-1: get robot moving, mouse-2: play on this square"))) 899 mouse-1: get robot moving, mouse-2: play on this square")))
900 (delete-char 1) 900 (delete-char 1)
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
909 (intangible t) 909 (intangible t)
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)))
927 (if (setq intangible (not intangible)) 927 (if (setq intangible (not intangible))
928 (put-text-property point (point) 'intangible 2)) 928 (put-text-property point (point) 'intangible 2))
939 '(mouse-face highlight help-echo "\ 939 '(mouse-face highlight help-echo "\
940 mouse-1: get robot moving, mouse-2: play on this square"))) 940 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)))))
948 (or intangible 948 (or intangible
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.
981 981
982 ;; When someone succeeds in filling a qtuple, we draw a line over the five 982 ;; When someone succeeds in filling a qtuple, we draw a line over the five
983 ;; corresponding squares. One problem is that the program does not know which 983 ;; corresponding squares. One problem is that the program does not know which
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
1045 1045
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
1347 ;;;_ + Distance-calculation functions 1347 ;;;_ + Distance-calculation functions
1348 ;;;_ - square (a) 1348 ;;;_ - square (a)
1355 1355
1356 ;;;_ - calc-distance-of-robot-from (direction) 1356 ;;;_ - calc-distance-of-robot-from (direction)
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)
1366 (let ((r (get sym 'r)) 1366 (let ((r (get sym 'r))
1367 (d (calc-distance-of-robot-from sym))) 1367 (d (calc-distance-of-robot-from sym)))
1369 (* 0.5 (- 1 (/ d r))) 1369 (* 0.5 (- 1 (/ d r)))
1370 0))) 1370 0)))
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)
1626 1622 (landmark 2)))
1627 (lm 2)))
1628
1629
1630 ;;;_ + lm: The function you invoke to play
1631 1623
1632 ;;;###autoload 1624 ;;;###autoload
1633 (defalias 'landmark 'lm) 1625 (defun landmark (parg)
1634 ;;;###autoload 1626 "Start or resume an Landmark game.
1635 (defun lm (parg)
1636 "Start or resume an Lm 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
1640 prefix arg | robot is auto-started | weights are saved from last game 1630 prefix arg | robot is auto-started | weights are saved from last game
1641 --------------------------------------------------------------------- 1631 ---------------------------------------------------------------------
1642 none / 1 | yes | no 1632 none / 1 | yes | no
1643 2 | yes | yes 1633 2 | yes | yes
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))
1681 ((= parg 3) '(nil t)) 1671 ((= parg 3) '(nil t))
1682 ((= parg 4) '(nil nil)) 1672 ((= parg 4) '(nil nil))