Mercurial > emacs
annotate lisp/play/landmark.el @ 96905:43f0edb65a25
(Fns_selection_exists_p, Fns_selection_owner_p)
(Fx_get_selection_internal, Fns_rotate_cut_buffers_internal)
(Fns_own_selection_internal, Fx_disown_selection_internal)
(Fns_get_cut_buffer_internal, Fns_store_cut_buffer_internal):
Change to use 'doc: /* ... */' style of docstrings. Doc fixes.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 22 Jul 2008 19:25:08 +0000 |
parents | 949bd6ad1ba4 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
22388 | 1 ;;; landmark.el --- neural-network robot that learns landmarks |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
2 |
74509 | 3 ;; Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, |
79716 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
17905 | 5 |
38455 | 6 ;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>) |
17905 | 7 ;; Created: December 16, 1996 - first release to usenet |
54484 | 8 ;; Keywords: gomoku, neural network, adaptive search, chemotaxis |
17905 | 9 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
10 ;;;_* Usage |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
11 ;;; Just type |
71625 | 12 ;;; M-x eval-buffer |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
13 ;;; M-x lm-test-run |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
14 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
15 |
17905 | 16 ;; This file is part of GNU Emacs. |
17 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
18 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17905 | 19 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
20 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
21 ;; (at your option) any later version. |
17905 | 22 |
23 ;; GNU Emacs is distributed in the hope that it will be useful, | |
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
26 ;; GNU General Public License for more details. | |
27 | |
28 ;; You should have received a copy of the GNU General Public License | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
29 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17905 | 30 |
31 | |
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
38076
diff
changeset
|
32 ;;; Commentary: |
17905 | 33 ;;; Lm is a relatively non-participatory game in which a robot |
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 | |
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 | |
38 ;;; future. If the smell of the tree decreases, the robots weights are | |
39 ;;; adjusted to discourage a correct move. | |
40 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
41 ;;; In laymen's terms, the search space is initially flat. The point |
17905 | 42 ;;; of training is to "turn up the edges of the search space" so that |
43 ;;; the robot rolls toward the center. | |
44 | |
45 ;;; Further, do not become alarmed if the robot appears to oscillate | |
46 ;;; back and forth between two or a few positions. This simply means | |
47 ;;; it is currently caught in a local minimum and is doing its best to | |
48 ;;; work its way out. | |
49 | |
50 ;;; The version of this program as described has a small problem. a | |
51 ;;; move in a net direction can produce gross credit assignment. for | |
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 | |
54 ;;; west will be improved when they shouldn't | |
55 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
56 ;;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
57 ;;; concise problem description. |
17905 | 58 |
59 ;;;_* Require | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
60 (eval-when-compile (require 'cl)) |
17905 | 61 |
62 ;;;_* From Gomoku | |
63 | |
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
38076
diff
changeset
|
64 ;;; Code: |
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
38076
diff
changeset
|
65 |
21363 | 66 (defgroup lm nil |
67 "Neural-network robot that learns landmarks." | |
68 :prefix "lm-" | |
69 :group 'games) | |
70 | |
17905 | 71 ;;;_ + THE BOARD. |
72 | |
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 | |
75 ;; containing padding squares (coded with -1). These squares allow us to | |
74157 | 76 ;; detect when we are trying to move out of the board. We denote a square by |
17905 | 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. | |
79 ;; Similarly, vectors between squares may be given by two DX, DY coords or by | |
80 ;; one DEPL (the difference between indexes). | |
81 | |
82 (defvar lm-board-width nil | |
83 "Number of columns on the Lm board.") | |
84 (defvar lm-board-height nil | |
85 "Number of lines on the Lm board.") | |
86 | |
87 (defvar lm-board nil | |
88 "Vector recording the actual state of the Lm board.") | |
89 | |
90 (defvar lm-vector-length nil | |
91 "Length of lm-board vector.") | |
92 | |
93 (defvar lm-draw-limit nil | |
94 ;; This is usually set to 70% of the number of squares. | |
95 "After how many moves will Emacs offer a draw?") | |
96 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
97 (defvar lm-cx 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
98 "This is the x coordinate of the center of the board.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
99 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
100 (defvar lm-cy 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
101 "This is the y coordinate of the center of the board.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
102 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
103 (defvar lm-m 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
104 "This is the x dimension of the playing board.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
105 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
106 (defvar lm-n 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
107 "This is the y dimension of the playing board.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
108 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
109 |
17905 | 110 (defun lm-xy-to-index (x y) |
111 "Translate X, Y cartesian coords into the corresponding board index." | |
112 (+ (* y lm-board-width) x y)) | |
113 | |
114 (defun lm-index-to-x (index) | |
115 "Return corresponding x-coord of board INDEX." | |
116 (% index (1+ lm-board-width))) | |
117 | |
118 (defun lm-index-to-y (index) | |
119 "Return corresponding y-coord of board INDEX." | |
120 (/ index (1+ lm-board-width))) | |
121 | |
122 (defun lm-init-board () | |
123 "Create the lm-board vector and fill it with initial values." | |
124 (setq lm-board (make-vector lm-vector-length 0)) | |
125 ;; Every square is 0 (i.e. empty) except padding squares: | |
126 (let ((i 0) (ii (1- lm-vector-length))) | |
127 (while (<= i lm-board-width) ; The squares in [0..width] and in | |
128 (aset lm-board i -1) ; [length - width - 1..length - 1] | |
129 (aset lm-board ii -1) ; are padding squares. | |
130 (setq i (1+ i) | |
131 ii (1- ii)))) | |
132 (let ((i 0)) | |
133 (while (< i lm-vector-length) | |
134 (aset lm-board i -1) ; and also all k*(width+1) | |
135 (setq i (+ i lm-board-width 1))))) | |
136 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
137 ;;;_ + DISPLAYING THE BOARD. |
17905 | 138 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
139 ;; You may change these values if you have a small screen or if the squares |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
140 ;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1). |
17905 | 141 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
142 (defconst lm-square-width 2 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
143 "*Horizontal spacing between squares on the Lm board.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
144 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
145 (defconst lm-square-height 1 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
146 "*Vertical spacing between squares on the Lm board.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
147 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
148 (defconst lm-x-offset 3 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
149 "*Number of columns between the Lm board and the side of the window.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
150 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
151 (defconst lm-y-offset 1 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
152 "*Number of lines between the Lm board and the top of the window.") |
17905 | 153 |
154 | |
155 ;;;_ + LM MODE AND KEYMAP. | |
156 | |
21363 | 157 (defcustom lm-mode-hook nil |
158 "If non-nil, its value is called on entry to Lm mode." | |
159 :type 'hook | |
160 :group 'lm) | |
17905 | 161 |
162 (defvar lm-mode-map nil | |
163 "Local keymap to use in Lm mode.") | |
164 | |
165 (if lm-mode-map nil | |
166 (setq lm-mode-map (make-sparse-keymap)) | |
167 | |
168 ;; Key bindings for cursor motion. | |
169 (define-key lm-mode-map "y" 'lm-move-nw) ; y | |
170 (define-key lm-mode-map "u" 'lm-move-ne) ; u | |
171 (define-key lm-mode-map "b" 'lm-move-sw) ; b | |
172 (define-key lm-mode-map "n" 'lm-move-se) ; n | |
173 (define-key lm-mode-map "h" 'backward-char) ; h | |
174 (define-key lm-mode-map "l" 'forward-char) ; l | |
175 (define-key lm-mode-map "j" 'lm-move-down) ; j | |
176 (define-key lm-mode-map "k" 'lm-move-up) ; k | |
177 | |
178 (define-key lm-mode-map [kp-7] 'lm-move-nw) | |
179 (define-key lm-mode-map [kp-9] 'lm-move-ne) | |
180 (define-key lm-mode-map [kp-1] 'lm-move-sw) | |
181 (define-key lm-mode-map [kp-3] 'lm-move-se) | |
182 (define-key lm-mode-map [kp-4] 'backward-char) | |
183 (define-key lm-mode-map [kp-6] 'forward-char) | |
184 (define-key lm-mode-map [kp-2] 'lm-move-down) | |
185 (define-key lm-mode-map [kp-8] 'lm-move-up) | |
186 | |
187 (define-key lm-mode-map "\C-n" 'lm-move-down) ; C-n | |
188 (define-key lm-mode-map "\C-p" 'lm-move-up) ; C-p | |
189 | |
190 ;; Key bindings for entering Human moves. | |
191 (define-key lm-mode-map "X" 'lm-human-plays) ; X | |
192 (define-key lm-mode-map "x" 'lm-human-plays) ; x | |
193 | |
194 (define-key lm-mode-map " " 'lm-start-robot) ; SPC | |
195 (define-key lm-mode-map [down-mouse-1] 'lm-start-robot) | |
196 (define-key lm-mode-map [drag-mouse-1] 'lm-click) | |
197 (define-key lm-mode-map [mouse-1] 'lm-click) | |
198 (define-key lm-mode-map [down-mouse-2] 'lm-click) | |
199 (define-key lm-mode-map [mouse-2] 'lm-mouse-play) | |
200 (define-key lm-mode-map [drag-mouse-2] 'lm-mouse-play) | |
201 | |
49174
1181f774d922
(lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents:
41320
diff
changeset
|
202 (define-key lm-mode-map [remap previous-line] 'lm-move-up) |
1181f774d922
(lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents:
41320
diff
changeset
|
203 (define-key lm-mode-map [remap next-line] 'lm-move-down) |
1181f774d922
(lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents:
41320
diff
changeset
|
204 (define-key lm-mode-map [remap beginning-of-line] 'lm-beginning-of-line) |
1181f774d922
(lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents:
41320
diff
changeset
|
205 (define-key lm-mode-map [remap end-of-line] 'lm-end-of-line) |
1181f774d922
(lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents:
41320
diff
changeset
|
206 (define-key lm-mode-map [remap undo] 'lm-human-takes-back) |
1181f774d922
(lm-mode-map): Use command remapping instead of
Andreas Schwab <schwab@suse.de>
parents:
41320
diff
changeset
|
207 (define-key lm-mode-map [remap advertised-undo] 'lm-human-takes-back)) |
17905 | 208 |
209 (defvar lm-emacs-won () | |
210 "*For making font-lock use the winner's face for the line.") | |
211 | |
69895
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
212 (defface lm-font-lock-face-O '((((class color)) :foreground "red") |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
213 (t :weight bold)) |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
214 "*Face to use for Emacs' O." |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
215 :version "22.1" |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
216 :group 'lm) |
17905 | 217 |
69895
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
218 (defface lm-font-lock-face-X '((((class color)) :foreground "green") |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
219 (t :weight bold)) |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
220 "*Face to use for your X." |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
221 :version "22.1" |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
222 :group 'lm) |
17905 | 223 |
224 (defvar lm-font-lock-keywords | |
69895
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
225 '(("O" . 'lm-font-lock-face-O) |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
226 ("X" . 'lm-font-lock-face-X) |
17905 | 227 ("[-|/\\]" 0 (if lm-emacs-won |
69895
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
228 'lm-font-lock-face-O |
215057e97d56
(lm-font-lock-face-O, lm-font-lock-face-X): Make them faces.
Richard M. Stallman <rms@gnu.org>
parents:
68866
diff
changeset
|
229 'lm-font-lock-face-X))) |
17905 | 230 "*Font lock rules for Lm.") |
231 | |
232 (put 'lm-mode 'front-sticky | |
233 (put 'lm-mode 'rear-nonsticky '(intangible))) | |
234 (put 'lm-mode 'intangible 1) | |
41317
a33250d752d4
Mark lm-mode as special. Suggested by Klaus Straubinger <ksnetz@arcor.de>
Eli Zaretskii <eliz@gnu.org>
parents:
39866
diff
changeset
|
235 ;; This one is for when they set view-read-only to t: Landmark cannot |
a33250d752d4
Mark lm-mode as special. Suggested by Klaus Straubinger <ksnetz@arcor.de>
Eli Zaretskii <eliz@gnu.org>
parents:
39866
diff
changeset
|
236 ;; allow View Mode to be activated in its buffer. |
41320 | 237 (put 'lm-mode 'mode-class 'special) |
17905 | 238 |
239 (defun lm-mode () | |
240 "Major mode for playing Lm against Emacs. | |
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 | |
243 marks horizontally, vertically or in diagonal. | |
244 | |
245 You play by moving the cursor over the square you choose and hitting \\[lm-human-plays]. | |
246 | |
247 Other useful commands: | |
248 \\{lm-mode-map} | |
249 Entry to this mode calls the value of `lm-mode-hook' if that value | |
250 is non-nil. One interesting value is `turn-on-font-lock'." | |
251 (interactive) | |
62770 | 252 (kill-all-local-variables) |
17905 | 253 (setq major-mode 'lm-mode |
254 mode-name "Lm") | |
255 (lm-display-statistics) | |
256 (use-local-map lm-mode-map) | |
257 (make-local-variable 'font-lock-defaults) | |
258 (setq font-lock-defaults '(lm-font-lock-keywords t)) | |
259 (toggle-read-only t) | |
62770 | 260 (run-mode-hooks 'lm-mode-hook)) |
17905 | 261 |
262 | |
263 ;;;_ + THE SCORE TABLE. | |
264 | |
265 | |
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 | |
268 ;; the highest score. | |
269 | |
270 (defvar lm-score-table nil | |
271 "Vector recording the actual score of the free squares.") | |
272 | |
273 | |
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 | |
276 ;; internested 5-tuples of contiguous squares (called qtuples). | |
277 ;; | |
278 ;; The aim of the program is to fill one qtuple with its O's while preventing | |
279 ;; you from filling another one with your X's. To that effect, it computes a | |
280 ;; score for every qtuple, with better qtuples having better scores. Of | |
281 ;; course, the score of a qtuple (taken in isolation) is just determined by | |
282 ;; its contents as a set, i.e. not considering the order of its elements. The | |
283 ;; highest score is given to the "OOOO" qtuples because playing in such a | |
284 ;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because | |
285 ;; not playing in it is just loosing the game, and so on. Note that a | |
286 ;; "polluted" qtuple, i.e. one containing at least one X and at least one O, | |
287 ;; has score zero because there is no more any point in playing in it, from | |
288 ;; both an attacking and a defending point of view. | |
289 ;; | |
290 ;; Given the score of every qtuple, the score of a given free square on the | |
291 ;; board is just the sum of the scores of all the qtuples to which it belongs, | |
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 | |
294 ;; the qtuples. | |
295 ;; | |
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 | |
298 ;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !) | |
299 ;; should be preferred. | |
300 | |
301 | |
302 ;; Here are the scores of the nine "non-polluted" configurations. Tuning | |
303 ;; these values will change (hopefully improve) the strength of the program | |
304 ;; and may change its style (rather aggressive here). | |
305 | |
306 (defconst nil-score 7 "Score of an empty qtuple.") | |
307 (defconst Xscore 15 "Score of a qtuple containing one X.") | |
308 (defconst XXscore 400 "Score of a qtuple containing two X's.") | |
309 (defconst XXXscore 1800 "Score of a qtuple containing three X's.") | |
310 (defconst XXXXscore 100000 "Score of a qtuple containing four X's.") | |
311 (defconst Oscore 35 "Score of a qtuple containing one O.") | |
312 (defconst OOscore 800 "Score of a qtuple containing two O's.") | |
313 (defconst OOOscore 15000 "Score of a qtuple containing three O's.") | |
314 (defconst OOOOscore 800000 "Score of a qtuple containing four O's.") | |
315 | |
316 ;; These values are not just random: if, given the following situation: | |
317 ;; | |
318 ;; . . . . . . . O . | |
319 ;; . X X a . . . X . | |
320 ;; . . . X . . . X . | |
321 ;; . . . X . . . X . | |
322 ;; . . . . . . . b . | |
323 ;; | |
324 ;; you want Emacs to play in "a" and not in "b", then the parameters must | |
325 ;; satisfy the inequality: | |
326 ;; | |
327 ;; 6 * XXscore > XXXscore + XXscore | |
328 ;; | |
329 ;; because "a" mainly belongs to six "XX" qtuples (the others are less | |
330 ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other | |
331 ;; conditions are required to obtain sensible moves, but the previous example | |
332 ;; should illustrate the point. If you manage to improve on these values, | |
333 ;; please send me a note. Thanks. | |
334 | |
335 | |
336 ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the | |
337 ;; contents of a qtuple are uniquely determined by the sum of its elements and | |
338 ;; we just have to set up a translation table. | |
339 | |
340 (defconst lm-score-trans-table | |
341 (vector nil-score Xscore XXscore XXXscore XXXXscore 0 | |
342 Oscore 0 0 0 0 0 | |
343 OOscore 0 0 0 0 0 | |
344 OOOscore 0 0 0 0 0 | |
345 OOOOscore 0 0 0 0 0 | |
346 0) | |
347 "Vector associating qtuple contents to their score.") | |
348 | |
349 | |
350 ;; If you do not modify drastically the previous constants, the only way for a | |
351 ;; square to have a score higher than OOOOscore is to belong to a "OOOO" | |
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" | |
354 ;; qtuple. We may use these considerations to detect when a given move is | |
355 ;; winning or loosing. | |
356 | |
357 (defconst lm-winning-threshold OOOOscore | |
358 "Threshold score beyond which an Emacs move is winning.") | |
359 | |
360 (defconst lm-loosing-threshold XXXXscore | |
361 "Threshold score beyond which a human move is winning.") | |
362 | |
363 | |
364 (defun lm-strongest-square () | |
365 "Compute index of free square with highest score, or nil if none." | |
366 ;; We just have to loop other all squares. However there are two problems: | |
367 ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed | |
368 ;; up future searches, we set the score of padding or occupied squares | |
369 ;; to -1 whenever we meet them. | |
370 ;; 2/ We want to choose randomly between equally good moves. | |
371 (let ((score-max 0) | |
372 (count 0) ; Number of equally good moves | |
373 (square (lm-xy-to-index 1 1)) ; First square | |
374 (end (lm-xy-to-index lm-board-width lm-board-height)) | |
375 best-square score) | |
376 (while (<= square end) | |
377 (cond | |
378 ;; If score is lower (i.e. most of the time), skip to next: | |
379 ((< (aref lm-score-table square) score-max)) | |
380 ;; If score is better, beware of non free squares: | |
381 ((> (setq score (aref lm-score-table square)) score-max) | |
382 (if (zerop (aref lm-board square)) ; is it free ? | |
383 (setq count 1 ; yes: take it ! | |
384 best-square square | |
385 score-max score) | |
386 (aset lm-score-table square -1))) ; no: kill it ! | |
387 ;; If score is equally good, choose randomly. But first check freeness: | |
388 ((not (zerop (aref lm-board square))) | |
389 (aset lm-score-table square -1)) | |
390 ((zerop (random (setq count (1+ count)))) | |
391 (setq best-square square | |
392 score-max score))) | |
393 (setq square (1+ square))) ; try next square | |
394 best-square)) | |
395 | |
396 ;;;_ - INITIALIZING THE SCORE TABLE. | |
397 | |
398 ;; At initialization the board is empty so that every qtuple amounts for | |
399 ;; nil-score. Therefore, the score of any square is nil-score times the number | |
400 ;; of qtuples that pass through it. This number is 3 in a corner and 20 if you | |
401 ;; are sufficiently far from the sides. As computing the number is time | |
402 ;; consuming, we initialize every square with 20*nil-score and then only | |
403 ;; consider squares at less than 5 squares from one side. We speed this up by | |
404 ;; taking symmetry into account. | |
405 ;; Also, as it is likely that successive games will be played on a board with | |
406 ;; same size, it is a good idea to save the initial SCORE-TABLE configuration. | |
407 | |
408 (defvar lm-saved-score-table nil | |
409 "Recorded initial value of previous score table.") | |
410 | |
411 (defvar lm-saved-board-width nil | |
412 "Recorded value of previous board width.") | |
413 | |
414 (defvar lm-saved-board-height nil | |
415 "Recorded value of previous board height.") | |
416 | |
417 | |
418 (defun lm-init-score-table () | |
419 "Create the score table vector and fill it with initial values." | |
420 (if (and lm-saved-score-table ; Has it been stored last time ? | |
421 (= lm-board-width lm-saved-board-width) | |
422 (= lm-board-height lm-saved-board-height)) | |
423 (setq lm-score-table (copy-sequence lm-saved-score-table)) | |
424 ;; No, compute it: | |
425 (setq lm-score-table | |
426 (make-vector lm-vector-length (* 20 nil-score))) | |
427 (let (i j maxi maxj maxi2 maxj2) | |
428 (setq maxi (/ (1+ lm-board-width) 2) | |
429 maxj (/ (1+ lm-board-height) 2) | |
430 maxi2 (min 4 maxi) | |
431 maxj2 (min 4 maxj)) | |
432 ;; We took symmetry into account and could use it more if the board | |
433 ;; would have been square and not rectangular ! | |
434 ;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U | |
435 ;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the | |
436 ;; board may well be less than 8 by 8 ! | |
437 (setq i 1) | |
438 (while (<= i maxi2) | |
439 (setq j 1) | |
440 (while (<= j maxj) | |
441 (lm-init-square-score i j) | |
442 (setq j (1+ j))) | |
443 (setq i (1+ i))) | |
444 (while (<= i maxi) | |
445 (setq j 1) | |
446 (while (<= j maxj2) | |
447 (lm-init-square-score i j) | |
448 (setq j (1+ j))) | |
449 (setq i (1+ i)))) | |
450 (setq lm-saved-score-table (copy-sequence lm-score-table) | |
451 lm-saved-board-width lm-board-width | |
452 lm-saved-board-height lm-board-height))) | |
453 | |
454 (defun lm-nb-qtuples (i j) | |
455 "Return the number of qtuples containing square I,J." | |
456 ;; This function is complicated because we have to deal | |
457 ;; with ugly cases like 3 by 6 boards, but it works. | |
458 ;; If you have a simpler (and correct) solution, send it to me. Thanks ! | |
459 (let ((left (min 4 (1- i))) | |
460 (right (min 4 (- lm-board-width i))) | |
461 (up (min 4 (1- j))) | |
462 (down (min 4 (- lm-board-height j)))) | |
463 (+ -12 | |
464 (min (max (+ left right) 3) 8) | |
465 (min (max (+ up down) 3) 8) | |
466 (min (max (+ (min left up) (min right down)) 3) 8) | |
467 (min (max (+ (min right up) (min left down)) 3) 8)))) | |
468 | |
469 (defun lm-init-square-score (i j) | |
470 "Give initial score to square I,J and to its mirror images." | |
471 (let ((ii (1+ (- lm-board-width i))) | |
472 (jj (1+ (- lm-board-height j))) | |
473 (sc (* (lm-nb-qtuples i j) (aref lm-score-trans-table 0)))) | |
474 (aset lm-score-table (lm-xy-to-index i j) sc) | |
475 (aset lm-score-table (lm-xy-to-index ii j) sc) | |
476 (aset lm-score-table (lm-xy-to-index i jj) sc) | |
477 (aset lm-score-table (lm-xy-to-index ii jj) sc))) | |
478 ;;;_ - MAINTAINING THE SCORE TABLE. | |
479 | |
480 | |
481 ;; We do not provide functions for computing the SCORE-TABLE given the | |
482 ;; contents of the BOARD. This would involve heavy nested loops, with time | |
483 ;; proportional to the size of the board. It is better to update the | |
484 ;; SCORE-TABLE after each move. Updating needs not modify more than 36 | |
485 ;; squares: it is done in constant time. | |
486 | |
487 (defun lm-update-score-table (square dval) | |
488 "Update score table after SQUARE received a DVAL increment." | |
489 ;; The board has already been updated when this function is called. | |
490 ;; Updating scores is done by looking for qtuples boundaries in all four | |
491 ;; directions and then calling update-score-in-direction. | |
492 ;; Finally all squares received the right increment, and then are up to | |
493 ;; date, except possibly for SQUARE itself if we are taking a move back for | |
494 ;; its score had been set to -1 at the time. | |
495 (let* ((x (lm-index-to-x square)) | |
496 (y (lm-index-to-y square)) | |
497 (imin (max -4 (- 1 x))) | |
498 (jmin (max -4 (- 1 y))) | |
499 (imax (min 0 (- lm-board-width x 4))) | |
500 (jmax (min 0 (- lm-board-height y 4)))) | |
501 (lm-update-score-in-direction imin imax | |
502 square 1 0 dval) | |
503 (lm-update-score-in-direction jmin jmax | |
504 square 0 1 dval) | |
505 (lm-update-score-in-direction (max imin jmin) (min imax jmax) | |
506 square 1 1 dval) | |
507 (lm-update-score-in-direction (max (- 1 y) -4 | |
508 (- x lm-board-width)) | |
509 (min 0 (- x 5) | |
510 (- lm-board-height y 4)) | |
511 square -1 1 dval))) | |
512 | |
513 (defun lm-update-score-in-direction (left right square dx dy dval) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
514 "Update scores for all squares in the qtuples in range. |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
515 That is, those between the LEFTth square and the RIGHTth after SQUARE, |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
516 along the DX, DY direction, considering that DVAL has been added on SQUARE." |
17905 | 517 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well |
518 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that | |
519 ;; DX,DY direction. | |
520 (cond | |
521 ((> left right)) ; Quit | |
522 (t ; Else .. | |
523 (let (depl square0 square1 square2 count delta) | |
524 (setq depl (lm-xy-to-index dx dy) | |
525 square0 (+ square (* left depl)) | |
526 square1 (+ square (* right depl)) | |
527 square2 (+ square0 (* 4 depl))) | |
528 ;; Compute the contents of the first qtuple: | |
529 (setq square square0 | |
530 count 0) | |
531 (while (<= square square2) | |
532 (setq count (+ count (aref lm-board square)) | |
533 square (+ square depl))) | |
534 (while (<= square0 square1) | |
535 ;; Update the squares of the qtuple beginning in SQUARE0 and ending | |
536 ;; in SQUARE2. | |
537 (setq delta (- (aref lm-score-trans-table count) | |
538 (aref lm-score-trans-table (- count dval)))) | |
539 (cond ((not (zerop delta)) ; or else nothing to update | |
540 (setq square square0) | |
541 (while (<= square square2) | |
542 (if (zerop (aref lm-board square)) ; only for free squares | |
543 (aset lm-score-table square | |
544 (+ (aref lm-score-table square) delta))) | |
545 (setq square (+ square depl))))) | |
546 ;; Then shift the qtuple one square along DEPL, this only requires | |
547 ;; modifying SQUARE0 and SQUARE2. | |
548 (setq square2 (+ square2 depl) | |
549 count (+ count (- (aref lm-board square0)) | |
550 (aref lm-board square2)) | |
551 square0 (+ square0 depl))))))) | |
552 | |
553 ;;; | |
554 ;;; GAME CONTROL. | |
555 ;;; | |
556 | |
557 ;; Several variables are used to monitor a game, including a GAME-HISTORY (the | |
558 ;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back | |
559 ;; (anti-updating the score table) and to compute the table from scratch in | |
560 ;; case of an interruption. | |
561 | |
562 (defvar lm-game-in-progress nil | |
563 "Non-nil if a game is in progress.") | |
564 | |
565 (defvar lm-game-history nil | |
566 "A record of all moves that have been played during current game.") | |
567 | |
568 (defvar lm-number-of-moves nil | |
569 "Number of moves already played in current game.") | |
570 | |
571 (defvar lm-number-of-human-moves nil | |
572 "Number of moves already played by human in current game.") | |
573 | |
574 (defvar lm-emacs-played-first nil | |
575 "Non-nil if Emacs played first.") | |
576 | |
577 (defvar lm-human-took-back nil | |
578 "Non-nil if Human took back a move during the game.") | |
579 | |
580 (defvar lm-human-refused-draw nil | |
581 "Non-nil if Human refused Emacs offer of a draw.") | |
582 | |
583 (defvar lm-emacs-is-computing nil | |
584 ;; This is used to detect interruptions. Hopefully, it should not be needed. | |
585 "Non-nil if Emacs is in the middle of a computation.") | |
586 | |
587 | |
588 (defun lm-start-game (n m) | |
589 "Initialize a new game on an N by M board." | |
590 (setq lm-emacs-is-computing t) ; Raise flag | |
591 (setq lm-game-in-progress t) | |
592 (setq lm-board-width n | |
593 lm-board-height m | |
594 lm-vector-length (1+ (* (+ m 2) (1+ n))) | |
595 lm-draw-limit (/ (* 7 n m) 10)) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
596 (setq lm-emacs-won nil |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
597 lm-game-history nil |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
598 lm-number-of-moves 0 |
17905 | 599 lm-number-of-human-moves 0 |
600 lm-emacs-played-first nil | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
601 lm-human-took-back nil |
17905 | 602 lm-human-refused-draw nil) |
603 (lm-init-display n m) ; Display first: the rest takes time | |
604 (lm-init-score-table) ; INIT-BOARD requires that the score | |
605 (lm-init-board) ; table be already created. | |
606 (setq lm-emacs-is-computing nil)) | |
607 | |
608 (defun lm-play-move (square val &optional dont-update-score) | |
609 "Go to SQUARE, play VAL and update everything." | |
610 (setq lm-emacs-is-computing t) ; Raise flag | |
611 (cond ((= 1 val) ; a Human move | |
612 (setq lm-number-of-human-moves (1+ lm-number-of-human-moves))) | |
613 ((zerop lm-number-of-moves) ; an Emacs move. Is it first ? | |
614 (setq lm-emacs-played-first t))) | |
615 (setq lm-game-history | |
616 (cons (cons square (aref lm-score-table square)) | |
617 lm-game-history) | |
618 lm-number-of-moves (1+ lm-number-of-moves)) | |
619 (lm-plot-square square val) | |
620 (aset lm-board square val) ; *BEFORE* UPDATE-SCORE ! | |
621 (if dont-update-score nil | |
622 (lm-update-score-table square val) ; previous val was 0: dval = val | |
623 (aset lm-score-table square -1)) | |
624 (setq lm-emacs-is-computing nil)) | |
625 | |
626 (defun lm-take-back () | |
627 "Take back last move and update everything." | |
628 (setq lm-emacs-is-computing t) | |
629 (let* ((last-move (car lm-game-history)) | |
630 (square (car last-move)) | |
631 (oldval (aref lm-board square))) | |
632 (if (= 1 oldval) | |
633 (setq lm-number-of-human-moves (1- lm-number-of-human-moves))) | |
634 (setq lm-game-history (cdr lm-game-history) | |
635 lm-number-of-moves (1- lm-number-of-moves)) | |
636 (lm-plot-square square 0) | |
637 (aset lm-board square 0) ; *BEFORE* UPDATE-SCORE ! | |
638 (lm-update-score-table square (- oldval)) | |
639 (aset lm-score-table square (cdr last-move))) | |
640 (setq lm-emacs-is-computing nil)) | |
641 | |
642 | |
643 ;;;_ + SESSION CONTROL. | |
644 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
645 (defvar lm-number-of-trials 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
646 "The number of times that landmark has been run.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
647 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
648 (defvar lm-sum-of-moves 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
649 "The total number of moves made in all games.") |
17905 | 650 |
651 (defvar lm-number-of-emacs-wins 0 | |
652 "Number of games Emacs won in this session.") | |
653 | |
654 (defvar lm-number-of-human-wins 0 | |
655 "Number of games you won in this session.") | |
656 | |
657 (defvar lm-number-of-draws 0 | |
658 "Number of games already drawn in this session.") | |
659 | |
660 | |
661 (defun lm-terminate-game (result) | |
662 "Terminate the current game with RESULT." | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
663 (setq lm-number-of-trials (1+ lm-number-of-trials)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
664 (setq lm-sum-of-moves (+ lm-sum-of-moves lm-number-of-moves)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
665 (if (eq result 'crash-game) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
666 (message |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
667 "Sorry, I have been interrupted and cannot resume that game...")) |
17905 | 668 (lm-display-statistics) |
669 ;;(ding) | |
670 (setq lm-game-in-progress nil)) | |
671 | |
672 (defun lm-crash-game () | |
673 "What to do when Emacs detects it has been interrupted." | |
674 (setq lm-emacs-is-computing nil) | |
675 (lm-terminate-game 'crash-game) | |
676 (sit-for 4) ; Let's see the message | |
677 (lm-prompt-for-other-game)) | |
678 | |
679 | |
680 ;;;_ + INTERACTIVE COMMANDS. | |
681 | |
682 (defun lm-emacs-plays () | |
683 "Compute Emacs next move and play it." | |
684 (interactive) | |
685 (lm-switch-to-window) | |
686 (cond | |
687 (lm-emacs-is-computing | |
688 (lm-crash-game)) | |
689 ((not lm-game-in-progress) | |
690 (lm-prompt-for-other-game)) | |
691 (t | |
692 (message "Let me think...") | |
693 (let (square score) | |
694 (setq square (lm-strongest-square)) | |
695 (cond ((null square) | |
696 (lm-terminate-game 'nobody-won)) | |
697 (t | |
698 (setq score (aref lm-score-table square)) | |
699 (lm-play-move square 6) | |
700 (cond ((>= score lm-winning-threshold) | |
701 (setq lm-emacs-won t) ; for font-lock | |
702 (lm-find-filled-qtuple square 6) | |
703 (lm-terminate-game 'emacs-won)) | |
704 ((zerop score) | |
705 (lm-terminate-game 'nobody-won)) | |
706 ((and (> lm-number-of-moves lm-draw-limit) | |
707 (not lm-human-refused-draw) | |
708 (lm-offer-a-draw)) | |
709 (lm-terminate-game 'draw-agreed)) | |
710 (t | |
711 (lm-prompt-for-move))))))))) | |
712 | |
713 ;; For small square dimensions this is approximate, since though measured in | |
714 ;; pixels, event's (X . Y) is a character's top-left corner. | |
715 (defun lm-click (click) | |
716 "Position at the square where you click." | |
717 (interactive "e") | |
718 (and (windowp (posn-window (setq click (event-end click)))) | |
719 (numberp (posn-point click)) | |
720 (select-window (posn-window click)) | |
721 (setq click (posn-col-row click)) | |
722 (lm-goto-xy | |
723 (min (max (/ (+ (- (car click) | |
724 lm-x-offset | |
725 1) | |
726 (window-hscroll) | |
727 lm-square-width | |
728 (% lm-square-width 2) | |
729 (/ lm-square-width 2)) | |
730 lm-square-width) | |
731 1) | |
732 lm-board-width) | |
733 (min (max (/ (+ (- (cdr click) | |
734 lm-y-offset | |
735 1) | |
736 (let ((inhibit-point-motion-hooks t)) | |
737 (count-lines 1 (window-start))) | |
738 lm-square-height | |
739 (% lm-square-height 2) | |
740 (/ lm-square-height 2)) | |
741 lm-square-height) | |
742 1) | |
743 lm-board-height)))) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
744 |
17905 | 745 (defun lm-mouse-play (click) |
746 "Play at the square where you click." | |
747 (interactive "e") | |
748 (if (lm-click click) | |
749 (lm-human-plays))) | |
750 | |
751 (defun lm-human-plays () | |
752 "Signal to the Lm program that you have played. | |
753 You must have put the cursor on the square where you want to play. | |
754 If the game is finished, this command requests for another game." | |
755 (interactive) | |
756 (lm-switch-to-window) | |
757 (cond | |
758 (lm-emacs-is-computing | |
759 (lm-crash-game)) | |
760 ((not lm-game-in-progress) | |
761 (lm-prompt-for-other-game)) | |
762 (t | |
763 (let (square score) | |
764 (setq square (lm-point-square)) | |
765 (cond ((null square) | |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
766 (error "Your point is not on a square. Retry!")) |
17905 | 767 ((not (zerop (aref lm-board square))) |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
768 (error "Your point is not on a free square. Retry!")) |
17905 | 769 (t |
770 (setq score (aref lm-score-table square)) | |
771 (lm-play-move square 1) | |
772 (cond ((and (>= score lm-loosing-threshold) | |
773 ;; Just testing SCORE > THRESHOLD is not enough for | |
774 ;; detecting wins, it just gives an indication that | |
775 ;; we confirm with LM-FIND-FILLED-QTUPLE. | |
776 (lm-find-filled-qtuple square 1)) | |
777 (lm-terminate-game 'human-won)) | |
778 (t | |
779 (lm-emacs-plays))))))))) | |
780 | |
781 (defun lm-human-takes-back () | |
782 "Signal to the Lm program that you wish to take back your last move." | |
783 (interactive) | |
784 (lm-switch-to-window) | |
785 (cond | |
786 (lm-emacs-is-computing | |
787 (lm-crash-game)) | |
788 ((not lm-game-in-progress) | |
789 (message "Too late for taking back...") | |
790 (sit-for 4) | |
791 (lm-prompt-for-other-game)) | |
792 ((zerop lm-number-of-human-moves) | |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
793 (message "You have not played yet... Your move?")) |
17905 | 794 (t |
795 (message "One moment, please...") | |
796 ;; It is possible for the user to let Emacs play several consecutive | |
797 ;; moves, so that the best way to know when to stop taking back moves is | |
798 ;; to count the number of human moves: | |
799 (setq lm-human-took-back t) | |
800 (let ((number lm-number-of-human-moves)) | |
801 (while (= number lm-number-of-human-moves) | |
802 (lm-take-back))) | |
803 (lm-prompt-for-move)))) | |
804 | |
805 (defun lm-human-resigns () | |
806 "Signal to the Lm program that you may want to resign." | |
807 (interactive) | |
808 (lm-switch-to-window) | |
809 (cond | |
810 (lm-emacs-is-computing | |
811 (lm-crash-game)) | |
812 ((not lm-game-in-progress) | |
813 (message "There is no game in progress")) | |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
814 ((y-or-n-p "You mean, you resign? ") |
17905 | 815 (lm-terminate-game 'human-resigned)) |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
816 ((y-or-n-p "You mean, we continue? ") |
17905 | 817 (lm-prompt-for-move)) |
818 (t | |
819 (lm-terminate-game 'human-resigned)))) ; OK. Accept it | |
820 | |
821 ;;;_ + PROMPTING THE HUMAN PLAYER. | |
822 | |
823 (defun lm-prompt-for-move () | |
824 "Display a message asking for Human's move." | |
825 (message (if (zerop lm-number-of-human-moves) | |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
826 "Your move? (move to a free square and hit X, RET ...)" |
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
827 "Your move?")) |
17905 | 828 ;; This may seem silly, but if one omits the following line (or a similar |
829 ;; one), the cursor may very well go to some place where POINT is not. | |
830 (save-excursion (set-buffer (other-buffer)))) | |
831 | |
832 (defun lm-prompt-for-other-game () | |
833 "Ask for another game, and start it." | |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
834 (if (y-or-n-p "Another game? ") |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
835 (if (y-or-n-p "Retain learned weights ") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
836 (lm 2) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
837 (lm 1)) |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
838 (message "Chicken!"))) |
17905 | 839 |
840 (defun lm-offer-a-draw () | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
841 "Offer a draw and return t if Human accepted it." |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
842 (or (y-or-n-p "I offer you a draw. Do you accept it? ") |
17905 | 843 (not (setq lm-human-refused-draw t)))) |
844 | |
845 | |
846 (defun lm-max-width () | |
847 "Largest possible board width for the current window." | |
848 (1+ (/ (- (window-width (selected-window)) | |
849 lm-x-offset lm-x-offset 1) | |
850 lm-square-width))) | |
851 | |
852 (defun lm-max-height () | |
853 "Largest possible board height for the current window." | |
854 (1+ (/ (- (window-height (selected-window)) | |
855 lm-y-offset lm-y-offset 2) | |
856 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line ! | |
857 lm-square-height))) | |
858 | |
859 (defun lm-point-y () | |
860 "Return the board row where point is." | |
861 (let ((inhibit-point-motion-hooks t)) | |
862 (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1)) | |
863 lm-square-height)))) | |
864 | |
865 (defun lm-point-square () | |
866 "Return the index of the square point is on." | |
867 (let ((inhibit-point-motion-hooks t)) | |
868 (lm-xy-to-index (1+ (/ (- (current-column) lm-x-offset) | |
869 lm-square-width)) | |
870 (lm-point-y)))) | |
871 | |
872 (defun lm-goto-square (index) | |
873 "Move point to square number INDEX." | |
874 (lm-goto-xy (lm-index-to-x index) (lm-index-to-y index))) | |
875 | |
876 (defun lm-goto-xy (x y) | |
877 "Move point to square at X, Y coords." | |
878 (let ((inhibit-point-motion-hooks t)) | |
879 (goto-line (+ 1 lm-y-offset (* lm-square-height (1- y))))) | |
880 (move-to-column (+ lm-x-offset (* lm-square-width (1- x))))) | |
881 | |
882 (defun lm-plot-square (square value) | |
883 "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." | |
884 (or (= value 1) | |
885 (lm-goto-square square)) | |
886 (let ((inhibit-read-only t) | |
887 (inhibit-point-motion-hooks t)) | |
888 (insert-and-inherit (cond ((= value 1) ?.) | |
889 ((= value 2) ?N) | |
890 ((= value 3) ?S) | |
891 ((= value 4) ?E) | |
892 ((= value 5) ?W) | |
893 ((= value 6) ?^))) | |
894 | |
30542
f03ab02d1f4e
(lm-font-lock-face-O, lm-font-lock-face-X)
Eli Zaretskii <eliz@gnu.org>
parents:
25227
diff
changeset
|
895 (and (zerop value) |
38076
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
896 (add-text-properties (1- (point)) (point) |
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
897 '(mouse-face highlight |
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
898 help-echo "\ |
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
899 mouse-1: get robot moving, mouse-2: play on this square"))) |
17905 | 900 (delete-char 1) |
901 (backward-char 1)) | |
902 (sit-for 0)) ; Display NOW | |
903 | |
904 (defun lm-init-display (n m) | |
905 "Display an N by M Lm board." | |
906 (buffer-disable-undo (current-buffer)) | |
907 (let ((inhibit-read-only t) | |
908 (point 1) opoint | |
909 (intangible t) | |
910 (i m) j x) | |
911 ;; Try to minimize number of chars (because of text properties) | |
912 (setq tab-width | |
913 (if (zerop (% lm-x-offset lm-square-width)) | |
914 lm-square-width | |
915 (max (/ (+ (% lm-x-offset lm-square-width) | |
916 lm-square-width 1) 2) 2))) | |
917 (erase-buffer) | |
918 (newline lm-y-offset) | |
919 (while (progn | |
920 (setq j n | |
921 x (- lm-x-offset lm-square-width)) | |
922 (while (>= (setq j (1- j)) 0) | |
923 (insert-char ?\t (/ (- (setq x (+ x lm-square-width)) | |
924 (current-column)) | |
925 tab-width)) | |
926 (insert-char ? (- x (current-column))) | |
927 (if (setq intangible (not intangible)) | |
928 (put-text-property point (point) 'intangible 2)) | |
929 (and (zerop j) | |
930 (= i (- m 2)) | |
931 (progn | |
932 (while (>= i 3) | |
933 (append-to-buffer (current-buffer) opoint (point)) | |
934 (setq i (- i 2))) | |
935 (goto-char (point-max)))) | |
936 (setq point (point)) | |
937 (insert ?=) | |
38076
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
938 (add-text-properties point (point) |
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
939 '(mouse-face highlight help-echo "\ |
30c899dc34c4
(lm-plot-square, lm-init-display): Add help-echo to mouse-highlighted text.
Eli Zaretskii <eliz@gnu.org>
parents:
37840
diff
changeset
|
940 mouse-1: get robot moving, mouse-2: play on this square"))) |
17905 | 941 (> (setq i (1- i)) 0)) |
942 (if (= i (1- m)) | |
943 (setq opoint point)) | |
944 (insert-char ?\n lm-square-height)) | |
945 (or (eq (char-after 1) ?.) | |
946 (put-text-property 1 2 'point-entered | |
39866
a4570786d40d
Do not double variables in the lambda-list.
Pavel Janík <Pavel@Janik.cz>
parents:
38455
diff
changeset
|
947 (lambda (x y) (if (bobp) (forward-char))))) |
17905 | 948 (or intangible |
949 (put-text-property point (point) 'intangible 2)) | |
950 (put-text-property point (point) 'point-entered | |
39866
a4570786d40d
Do not double variables in the lambda-list.
Pavel Janík <Pavel@Janik.cz>
parents:
38455
diff
changeset
|
951 (lambda (x y) (if (eobp) (backward-char)))) |
17905 | 952 (put-text-property (point-min) (point) 'category 'lm-mode)) |
953 (lm-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board | |
954 (sit-for 0)) ; Display NOW | |
955 | |
956 (defun lm-display-statistics () | |
957 "Obnoxiously display some statistics about previous games in mode line." | |
958 ;; We store this string in the mode-line-process local variable. | |
959 ;; This is certainly not the cleanest way out ... | |
960 (setq mode-line-process | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
961 (format ": Trials: %d, Avg#Moves: %d" |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
962 lm-number-of-trials |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
963 (if (zerop lm-number-of-trials) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
964 0 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
965 (/ lm-sum-of-moves lm-number-of-trials)))) |
17905 | 966 (force-mode-line-update)) |
967 | |
968 (defun lm-switch-to-window () | |
969 "Find or create the Lm buffer, and display it." | |
970 (interactive) | |
971 (let ((buff (get-buffer "*Lm*"))) | |
972 (if buff ; Buffer exists: | |
973 (switch-to-buffer buff) ; no problem. | |
974 (if lm-game-in-progress | |
975 (lm-crash-game)) ; buffer has been killed or something | |
976 (switch-to-buffer "*Lm*") ; Anyway, start anew. | |
977 (lm-mode)))) | |
978 | |
979 | |
980 ;;;_ + CROSSING WINNING QTUPLES. | |
981 | |
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 | |
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. | |
986 | |
987 (defun lm-find-filled-qtuple (square value) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
988 "Return t if SQUARE belongs to a qtuple filled with VALUEs." |
17905 | 989 (or (lm-check-filled-qtuple square value 1 0) |
990 (lm-check-filled-qtuple square value 0 1) | |
991 (lm-check-filled-qtuple square value 1 1) | |
992 (lm-check-filled-qtuple square value -1 1))) | |
993 | |
994 (defun lm-check-filled-qtuple (square value dx dy) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
995 "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." |
17905 | 996 (let ((a 0) (b 0) |
997 (left square) (right square) | |
998 (depl (lm-xy-to-index dx dy))) | |
999 (while (and (> a -4) ; stretch tuple left | |
1000 (= value (aref lm-board (setq left (- left depl))))) | |
1001 (setq a (1- a))) | |
1002 (while (and (< b (+ a 4)) ; stretch tuple right | |
1003 (= value (aref lm-board (setq right (+ right depl))))) | |
1004 (setq b (1+ b))) | |
1005 (cond ((= b (+ a 4)) ; tuple length = 5 ? | |
1006 (lm-cross-qtuple (+ square (* a depl)) (+ square (* b depl)) | |
1007 dx dy) | |
1008 t)))) | |
1009 | |
1010 (defun lm-cross-qtuple (square1 square2 dx dy) | |
1011 "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." | |
1012 (save-excursion ; Not moving point from last square | |
1013 (let ((depl (lm-xy-to-index dx dy)) | |
1014 (inhibit-read-only t) | |
1015 (inhibit-point-motion-hooks t)) | |
1016 ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 | |
1017 (while (/= square1 square2) | |
1018 (lm-goto-square square1) | |
1019 (setq square1 (+ square1 depl)) | |
1020 (cond | |
1021 ((= dy 0) ; Horizontal | |
1022 (forward-char 1) | |
1023 (insert-char ?- (1- lm-square-width) t) | |
1024 (delete-region (point) (progn | |
1025 (skip-chars-forward " \t") | |
1026 (point)))) | |
1027 ((= dx 0) ; Vertical | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1028 (let ((lm-n 1) |
17905 | 1029 (column (current-column))) |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1030 (while (< lm-n lm-square-height) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1031 (setq lm-n (1+ lm-n)) |
17905 | 1032 (forward-line 1) |
1033 (indent-to column) | |
1034 (insert-and-inherit ?|)))) | |
1035 ((= dx -1) ; 1st Diagonal | |
1036 (indent-to (prog1 (- (current-column) (/ lm-square-width 2)) | |
1037 (forward-line (/ lm-square-height 2)))) | |
1038 (insert-and-inherit ?/)) | |
1039 (t ; 2nd Diagonal | |
1040 (indent-to (prog1 (+ (current-column) (/ lm-square-width 2)) | |
1041 (forward-line (/ lm-square-height 2)))) | |
1042 (insert-and-inherit ?\\)))))) | |
1043 (sit-for 0)) ; Display NOW | |
1044 | |
1045 | |
1046 ;;;_ + CURSOR MOTION. | |
1047 | |
1048 ;; previous-line and next-line don't work right with intangible newlines | |
1049 (defun lm-move-down () | |
1050 "Move point down one row on the Lm board." | |
1051 (interactive) | |
1052 (if (< (lm-point-y) lm-board-height) | |
85478
786d3a985758
* term/x-win.el (x-gtk-stock-map, icon-map-list)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
78227
diff
changeset
|
1053 (forward-line 1)));;; lm-square-height))) |
17905 | 1054 |
1055 (defun lm-move-up () | |
1056 "Move point up one row on the Lm board." | |
1057 (interactive) | |
1058 (if (> (lm-point-y) 1) | |
85478
786d3a985758
* term/x-win.el (x-gtk-stock-map, icon-map-list)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
78227
diff
changeset
|
1059 (forward-line (- lm-square-height)))) |
17905 | 1060 |
1061 (defun lm-move-ne () | |
1062 "Move point North East on the Lm board." | |
1063 (interactive) | |
1064 (lm-move-up) | |
1065 (forward-char)) | |
1066 | |
1067 (defun lm-move-se () | |
1068 "Move point South East on the Lm board." | |
1069 (interactive) | |
1070 (lm-move-down) | |
1071 (forward-char)) | |
1072 | |
1073 (defun lm-move-nw () | |
1074 "Move point North West on the Lm board." | |
1075 (interactive) | |
1076 (lm-move-up) | |
1077 (backward-char)) | |
1078 | |
1079 (defun lm-move-sw () | |
1080 "Move point South West on the Lm board." | |
1081 (interactive) | |
1082 (lm-move-down) | |
1083 (backward-char)) | |
1084 | |
1085 (defun lm-beginning-of-line () | |
1086 "Move point to first square on the Lm board row." | |
1087 (interactive) | |
1088 (move-to-column lm-x-offset)) | |
1089 | |
1090 (defun lm-end-of-line () | |
1091 "Move point to last square on the Lm board row." | |
1092 (interactive) | |
1093 (move-to-column (+ lm-x-offset | |
1094 (* lm-square-width (1- lm-board-width))))) | |
1095 | |
1096 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1097 ;;;_ + Simulation variables |
17905 | 1098 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1099 ;;;_ - lm-nvar |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1100 (defvar lm-nvar 0.0075 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1101 "Not used. |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1102 Affects a noise generator which was used in an earlier incarnation of |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1103 this program to add a random element to the way moves were made.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1104 ;;;_ - lists of cardinal directions |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1105 ;;;_ : |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1106 (defvar lm-ns '(lm-n lm-s) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1107 "Used when doing something relative to the north and south axes.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1108 (defvar lm-ew '(lm-e lm-w) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1109 "Used when doing something relative to the east and west axes.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1110 (defvar lm-directions '(lm-n lm-s lm-e lm-w) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1111 "The cardinal directions.") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1112 (defvar lm-8-directions |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1113 '((lm-n) (lm-n lm-w) (lm-w) (lm-s lm-w) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1114 (lm-s) (lm-s lm-e) (lm-e) (lm-n lm-e)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1115 "The full 8 possible directions.") |
17905 | 1116 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1117 (defvar lm-number-of-moves |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1118 "The number of moves made by the robot so far.") |
17905 | 1119 |
1120 | |
1121 ;;;_* Terry's mods to create lm.el | |
1122 | |
1123 ;;;(setq lm-debug nil) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1124 (defvar lm-debug nil |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1125 "If non-nil, debugging is printed.") |
21363 | 1126 (defcustom lm-one-moment-please nil |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1127 "If non-nil, print \"One moment please\" when a new board is generated. |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1128 The drawback of this is you don't see how many moves the last run took |
21363 | 1129 because it is overwritten by \"One moment please\"." |
1130 :type 'boolean | |
1131 :group 'lm) | |
1132 (defcustom lm-output-moves t | |
1133 "If non-nil, output number of moves so far on a move-by-move basis." | |
1134 :type 'boolean | |
1135 :group 'lm) | |
17905 | 1136 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1137 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1138 (defun lm-weights-debug () |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1139 (if lm-debug |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1140 (progn (lm-print-wts) (lm-blackbox) (lm-print-y,s,noise) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1141 (lm-print-smell)))) |
17905 | 1142 |
1143 ;;;_ - Printing various things | |
1144 (defun lm-print-distance-int (direction) | |
1145 (interactive) | |
1146 (insert (format "%S %S " direction (get direction 'distance)))) | |
1147 | |
1148 | |
1149 (defun lm-print-distance () | |
1150 (insert (format "tree: %S \n" (calc-distance-of-robot-from 'lm-tree))) | |
1151 (mapc 'lm-print-distance-int lm-directions)) | |
1152 | |
1153 | |
1154 ;;(setq direction 'lm-n) | |
1155 ;;(get 'lm-n 'lm-s) | |
1156 (defun lm-nslify-wts-int (direction) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1157 (mapcar (lambda (target-direction) |
17905 | 1158 (get direction target-direction)) |
1159 lm-directions)) | |
1160 | |
1161 | |
1162 (defun lm-nslify-wts () | |
1163 (interactive) | |
1164 (let ((l (apply 'append (mapcar 'lm-nslify-wts-int lm-directions)))) | |
1165 (insert (format "set data_value WTS \n %s \n" l)) | |
1166 (insert (format "/* max: %S min: %S */" | |
1167 (eval (cons 'max l)) (eval (cons 'min l)))))) | |
1168 | |
1169 (defun lm-print-wts-int (direction) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1170 (mapc (lambda (target-direction) |
17905 | 1171 (insert (format "%S %S %S " |
1172 direction | |
1173 target-direction | |
1174 (get direction target-direction)))) | |
1175 lm-directions) | |
1176 (insert "\n")) | |
1177 | |
1178 (defun lm-print-wts () | |
1179 (interactive) | |
1180 (save-excursion | |
1181 (set-buffer "*lm-wts*") | |
1182 (insert "==============================\n") | |
1183 (mapc 'lm-print-wts-int lm-directions))) | |
1184 | |
1185 (defun lm-print-moves (moves) | |
1186 (interactive) | |
1187 (save-excursion | |
1188 (set-buffer "*lm-moves*") | |
1189 (insert (format "%S\n" moves)))) | |
1190 | |
1191 | |
1192 (defun lm-print-y,s,noise-int (direction) | |
1193 (insert (format "%S:lm-y %S, s %S, noise %S \n" | |
1194 (symbol-name direction) | |
1195 (get direction 'y_t) | |
1196 (get direction 's) | |
1197 (get direction 'noise) | |
1198 ))) | |
1199 | |
1200 (defun lm-print-y,s,noise () | |
1201 (interactive) | |
1202 (save-excursion | |
1203 (set-buffer "*lm-y,s,noise*") | |
1204 (insert "==============================\n") | |
1205 (mapc 'lm-print-y,s,noise-int lm-directions))) | |
1206 | |
1207 (defun lm-print-smell-int (direction) | |
1208 (insert (format "%S: smell: %S \n" | |
1209 (symbol-name direction) | |
1210 (get direction 'smell)))) | |
1211 | |
1212 (defun lm-print-smell () | |
1213 (interactive) | |
1214 (save-excursion | |
1215 (set-buffer "*lm-smell*") | |
1216 (insert "==============================\n") | |
1217 (insert (format "tree: %S \n" (get 'z 't))) | |
1218 (mapc 'lm-print-smell-int lm-directions))) | |
1219 | |
1220 (defun lm-print-w0-int (direction) | |
1221 (insert (format "%S: w0: %S \n" | |
1222 (symbol-name direction) | |
1223 (get direction 'w0)))) | |
1224 | |
1225 (defun lm-print-w0 () | |
1226 (interactive) | |
1227 (save-excursion | |
1228 (set-buffer "*lm-w0*") | |
1229 (insert "==============================\n") | |
1230 (mapc 'lm-print-w0-int lm-directions))) | |
1231 | |
1232 (defun lm-blackbox () | |
1233 (save-excursion | |
1234 (set-buffer "*lm-blackbox*") | |
1235 (insert "==============================\n") | |
1236 (insert "I smell: ") | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1237 (mapc (lambda (direction) |
17905 | 1238 (if (> (get direction 'smell) 0) |
1239 (insert (format "%S " direction)))) | |
1240 lm-directions) | |
1241 (insert "\n") | |
1242 | |
1243 (insert "I move: ") | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1244 (mapc (lambda (direction) |
17905 | 1245 (if (> (get direction 'y_t) 0) |
1246 (insert (format "%S " direction)))) | |
1247 lm-directions) | |
1248 (insert "\n") | |
1249 (lm-print-wts-blackbox) | |
1250 (insert (format "z_t-z_t-1: %S" (- (get 'z 't) (get 'z 't-1)))) | |
1251 (lm-print-distance) | |
1252 (insert "\n"))) | |
1253 | |
1254 (defun lm-print-wts-blackbox () | |
1255 (interactive) | |
1256 (mapc 'lm-print-wts-int lm-directions)) | |
1257 | |
1258 ;;;_ - learning parameters | |
21363 | 1259 (defcustom lm-bound 0.005 |
1260 "The maximum that w0j may be." | |
1261 :type 'number | |
1262 :group 'lm) | |
1263 (defcustom lm-c 1.0 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1264 "A factor applied to modulate the increase in wij. |
21363 | 1265 Used in the function lm-update-normal-weights." |
1266 :type 'number | |
1267 :group 'lm) | |
1268 (defcustom lm-c-naught 0.5 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1269 "A factor applied to modulate the increase in w0j. |
21363 | 1270 Used in the function lm-update-naught-weights." |
1271 :type 'number | |
1272 :group 'lm) | |
17905 | 1273 (defvar lm-initial-w0 0.0) |
1274 (defvar lm-initial-wij 0.0) | |
21363 | 1275 (defcustom lm-no-payoff 0 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1276 "The amount of simulation cycles that have occurred with no movement. |
21363 | 1277 Used to move the robot when he is stuck in a rut for some reason." |
1278 :type 'integer | |
1279 :group 'lm) | |
1280 (defcustom lm-max-stall-time 2 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1281 "The maximum number of cycles that the robot can remain stuck in a place. |
21363 | 1282 After this limit is reached, lm-random-move is called to push him out of it." |
1283 :type 'integer | |
1284 :group 'lm) | |
17905 | 1285 |
1286 | |
1287 ;;;_ + Randomizing functions | |
1288 ;;;_ - lm-flip-a-coin () | |
1289 (defun lm-flip-a-coin () | |
1290 (if (> (random 5000) 2500) | |
1291 -1 | |
1292 1)) | |
1293 ;;;_ : lm-very-small-random-number () | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1294 ;(defun lm-very-small-random-number () |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1295 ; (/ |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1296 ; (* (/ (random 900000) 900000.0) .0001))) |
17905 | 1297 ;;;_ : lm-randomize-weights-for (direction) |
1298 (defun lm-randomize-weights-for (direction) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1299 (mapc (lambda (target-direction) |
17905 | 1300 (put direction |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1301 target-direction |
17905 | 1302 (* (lm-flip-a-coin) (/ (random 10000) 10000.0)))) |
1303 lm-directions)) | |
1304 ;;;_ : lm-noise () | |
1305 (defun lm-noise () | |
1306 (* (- (/ (random 30001) 15000.0) 1) lm-nvar)) | |
1307 | |
1308 ;;;_ : lm-fix-weights-for (direction) | |
1309 (defun lm-fix-weights-for (direction) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1310 (mapc (lambda (target-direction) |
17905 | 1311 (put direction |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1312 target-direction |
17905 | 1313 lm-initial-wij)) |
1314 lm-directions)) | |
1315 | |
1316 | |
1317 ;;;_ + Plotting functions | |
1318 ;;;_ - lm-plot-internal (sym) | |
1319 (defun lm-plot-internal (sym) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1320 (lm-plot-square (lm-xy-to-index |
17905 | 1321 (get sym 'x) |
1322 (get sym 'y)) | |
1323 (get sym 'sym))) | |
1324 ;;;_ - lm-plot-landmarks () | |
1325 (defun lm-plot-landmarks () | |
1326 (setq lm-cx (/ lm-board-width 2)) | |
1327 (setq lm-cy (/ lm-board-height 2)) | |
1328 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1329 (put 'lm-n 'x lm-cx) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1330 (put 'lm-n 'y 1) |
17905 | 1331 (put 'lm-n 'sym 2) |
1332 | |
1333 (put 'lm-tree 'x lm-cx) | |
1334 (put 'lm-tree 'y lm-cy) | |
1335 (put 'lm-tree 'sym 6) | |
1336 | |
1337 (put 'lm-s 'x lm-cx) | |
1338 (put 'lm-s 'y lm-board-height) | |
1339 (put 'lm-s 'sym 3) | |
1340 | |
1341 (put 'lm-w 'x 1) | |
1342 (put 'lm-w 'y (/ lm-board-height 2)) | |
1343 (put 'lm-w 'sym 5) | |
1344 | |
1345 (put 'lm-e 'x lm-board-width) | |
1346 (put 'lm-e 'y (/ lm-board-height 2)) | |
1347 (put 'lm-e 'sym 4) | |
1348 | |
1349 (mapc 'lm-plot-internal '(lm-n lm-s lm-e lm-w lm-tree))) | |
1350 | |
1351 | |
1352 | |
1353 ;;;_ + Distance-calculation functions | |
1354 ;;;_ - square (a) | |
1355 (defun square (a) | |
1356 (* a a)) | |
1357 | |
1358 ;;;_ - distance (x x0 y y0) | |
1359 (defun distance (x x0 y y0) | |
1360 (sqrt (+ (square (- x x0)) (square (- y y0))))) | |
1361 | |
1362 ;;;_ - calc-distance-of-robot-from (direction) | |
1363 (defun calc-distance-of-robot-from (direction) | |
1364 (put direction 'distance | |
1365 (distance (get direction 'x) | |
1366 (lm-index-to-x (lm-point-square)) | |
1367 (get direction 'y) | |
1368 (lm-index-to-y (lm-point-square))))) | |
1369 | |
1370 ;;;_ - calc-smell-internal (sym) | |
1371 (defun calc-smell-internal (sym) | |
1372 (let ((r (get sym 'r)) | |
1373 (d (calc-distance-of-robot-from sym))) | |
1374 (if (> (* 0.5 (- 1 (/ d r))) 0) | |
1375 (* 0.5 (- 1 (/ d r))) | |
1376 0))) | |
1377 | |
1378 | |
1379 ;;;_ + Learning (neural) functions | |
1380 (defun lm-f (x) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1381 (cond |
17905 | 1382 ((> x lm-bound) lm-bound) |
1383 ((< x 0.0) 0.0) | |
1384 (t x))) | |
1385 | |
1386 (defun lm-y (direction) | |
1387 (let ((noise (put direction 'noise (lm-noise)))) | |
1388 (put direction 'y_t | |
1389 (if (> (get direction 's) 0.0) | |
1390 1.0 | |
1391 0.0)))) | |
1392 | |
1393 (defun lm-update-normal-weights (direction) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1394 (mapc (lambda (target-direction) |
17905 | 1395 (put direction target-direction |
1396 (+ | |
1397 (get direction target-direction) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1398 (* lm-c |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1399 (- (get 'z 't) (get 'z 't-1)) |
17905 | 1400 (get target-direction 'y_t) |
1401 (get direction 'smell))))) | |
1402 lm-directions)) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1403 |
17905 | 1404 (defun lm-update-naught-weights (direction) |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1405 (mapc (lambda (target-direction) |
17905 | 1406 (put direction 'w0 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1407 (lm-f |
17905 | 1408 (+ |
1409 (get direction 'w0) | |
1410 (* lm-c-naught | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1411 (- (get 'z 't) (get 'z 't-1)) |
17905 | 1412 (get direction 'y_t)))))) |
1413 lm-directions)) | |
1414 | |
1415 | |
1416 ;;;_ + Statistics gathering and creating functions | |
1417 | |
1418 (defun lm-calc-current-smells () | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1419 (mapc (lambda (direction) |
17905 | 1420 (put direction 'smell (calc-smell-internal direction))) |
1421 lm-directions)) | |
1422 | |
1423 (defun lm-calc-payoff () | |
1424 (put 'z 't-1 (get 'z 't)) | |
1425 (put 'z 't (calc-smell-internal 'lm-tree)) | |
1426 (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) | |
1427 (incf lm-no-payoff) | |
1428 (setf lm-no-payoff 0))) | |
1429 | |
1430 (defun lm-store-old-y_t () | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1431 (mapc (lambda (direction) |
17905 | 1432 (put direction 'y_t-1 (get direction 'y_t))) |
1433 lm-directions)) | |
1434 | |
1435 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1436 ;;;_ + Functions to move robot |
17905 | 1437 |
1438 (defun lm-confidence-for (target-direction) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1439 (apply '+ |
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1440 (get target-direction 'w0) |
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1441 (mapcar (lambda (direction) |
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1442 (* |
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1443 (get direction target-direction) |
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1444 (get direction 'smell))) |
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1445 lm-directions))) |
17905 | 1446 |
1447 | |
1448 (defun lm-calc-confidences () | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1449 (mapc (lambda (direction) |
17905 | 1450 (put direction 's (lm-confidence-for direction))) |
1451 lm-directions)) | |
1452 | |
1453 (defun lm-move () | |
1454 (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0)) | |
1455 (progn | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1456 (mapc (lambda (dir) (put dir 'y_t 0)) lm-ns) |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1457 (if lm-debug |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1458 (message "n-s normalization.")))) |
17905 | 1459 (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0)) |
1460 (progn | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1461 (mapc (lambda (dir) (put dir 'y_t 0)) lm-ew) |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1462 (if lm-debug |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1463 (message "e-w normalization")))) |
17905 | 1464 |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1465 (mapc (lambda (pair) |
17905 | 1466 (if (> (get (car pair) 'y_t) 0) |
1467 (funcall (car (cdr pair))))) | |
1468 '( | |
1469 (lm-n lm-move-up) | |
1470 (lm-s lm-move-down) | |
1471 (lm-e forward-char) | |
1472 (lm-w backward-char))) | |
1473 (lm-plot-square (lm-point-square) 1) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1474 (incf lm-number-of-moves) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1475 (if lm-output-moves |
65585
6d0d4d973f77
Message format spec fixes, commit no. 4
Deepak Goel <deego@gnufans.org>
parents:
64701
diff
changeset
|
1476 (message "Moves made: %d" lm-number-of-moves))) |
17905 | 1477 |
1478 | |
1479 (defun lm-random-move () | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1480 (mapc |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1481 (lambda (direction) (put direction 'y_t 0)) |
17905 | 1482 lm-directions) |
1483 (dolist (direction (nth (random 8) lm-8-directions)) | |
1484 (put direction 'y_t 1.0)) | |
1485 (lm-move)) | |
1486 | |
1487 (defun lm-amble-robot () | |
1488 (interactive) | |
1489 (while (> (calc-distance-of-robot-from 'lm-tree) 0) | |
1490 | |
1491 (lm-store-old-y_t) | |
1492 (lm-calc-current-smells) | |
1493 | |
1494 (if (> lm-no-payoff lm-max-stall-time) | |
1495 (lm-random-move) | |
1496 (progn | |
1497 (lm-calc-confidences) | |
1498 (mapc 'lm-y lm-directions) | |
1499 (lm-move))) | |
1500 | |
1501 (lm-calc-payoff) | |
1502 | |
1503 (mapc 'lm-update-normal-weights lm-directions) | |
1504 (mapc 'lm-update-naught-weights lm-directions) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1505 (if lm-debug |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1506 (lm-weights-debug))) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1507 (lm-terminate-game nil)) |
17905 | 1508 |
1509 | |
1510 ;;;_ - lm-start-robot () | |
1511 (defun lm-start-robot () | |
1512 "Signal to the Lm program that you have played. | |
1513 You must have put the cursor on the square where you want to play. | |
1514 If the game is finished, this command requests for another game." | |
1515 (interactive) | |
1516 (lm-switch-to-window) | |
1517 (cond | |
1518 (lm-emacs-is-computing | |
1519 (lm-crash-game)) | |
1520 ((not lm-game-in-progress) | |
1521 (lm-prompt-for-other-game)) | |
1522 (t | |
1523 (let (square score) | |
1524 (setq square (lm-point-square)) | |
1525 (cond ((null square) | |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
1526 (error "Your point is not on a square. Retry!")) |
17905 | 1527 ((not (zerop (aref lm-board square))) |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
1528 (error "Your point is not on a free square. Retry!")) |
17905 | 1529 (t |
1530 (progn | |
1531 (lm-plot-square square 1) | |
1532 | |
1533 (lm-store-old-y_t) | |
1534 (lm-calc-current-smells) | |
1535 (put 'z 't (calc-smell-internal 'lm-tree)) | |
1536 | |
1537 (lm-random-move) | |
1538 | |
1539 (lm-calc-payoff) | |
1540 | |
1541 (mapc 'lm-update-normal-weights lm-directions) | |
1542 (mapc 'lm-update-naught-weights lm-directions) | |
1543 (lm-amble-robot) | |
1544 ))))))) | |
1545 | |
1546 | |
1547 ;;;_ + Misc functions | |
1548 ;;;_ - lm-init (auto-start save-weights) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1549 (defvar lm-tree-r "") |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1550 |
17905 | 1551 (defun lm-init (auto-start save-weights) |
1552 | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1553 (setq lm-number-of-moves 0) |
17905 | 1554 |
1555 (lm-plot-landmarks) | |
1556 | |
1557 (if lm-debug | |
1558 (progn | |
1559 (save-excursion | |
1560 (set-buffer (get-buffer-create "*lm-w0*")) | |
1561 (erase-buffer) | |
1562 (set-buffer (get-buffer-create "*lm-moves*")) | |
1563 (set-buffer (get-buffer-create "*lm-wts*")) | |
1564 (erase-buffer) | |
1565 (set-buffer (get-buffer-create "*lm-y,s,noise*")) | |
1566 (erase-buffer) | |
1567 (set-buffer (get-buffer-create "*lm-smell*")) | |
1568 (erase-buffer) | |
1569 (set-buffer (get-buffer-create "*lm-blackbox*")) | |
1570 (erase-buffer) | |
1571 (set-buffer (get-buffer-create "*lm-distance*")) | |
1572 (erase-buffer)))) | |
1573 | |
1574 | |
1575 (lm-set-landmark-signal-strengths) | |
1576 | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1577 (mapc (lambda (direction) |
17905 | 1578 (put direction 'y_t 0.0)) |
1579 lm-directions) | |
1580 | |
1581 (if (not save-weights) | |
1582 (progn | |
1583 (mapc 'lm-fix-weights-for lm-directions) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1584 (mapc (lambda (direction) |
17905 | 1585 (put direction 'w0 lm-initial-w0)) |
1586 lm-directions)) | |
1587 (message "Weights preserved for this run.")) | |
1588 | |
1589 (if auto-start | |
1590 (progn | |
1591 (lm-goto-xy (1+ (random lm-board-width)) (1+ (random lm-board-height))) | |
1592 (lm-start-robot)))) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1593 |
17905 | 1594 |
1595 ;;;_ - something which doesn't work | |
1596 ; no-a-worka!! | |
1597 ;(defum lm-sum-list (list) | |
1598 ; (if (> (length list) 0) | |
1599 ; (+ (car list) (lm-sum-list (cdr list))) | |
1600 ; 0)) | |
1601 ; this a worka! | |
1602 ; (eval (cons '+ list)) | |
1603 ;;;_ - lm-set-landmark-signal-strengths () | |
1604 ;;; on a screen higher than wide, I noticed that the robot would amble | |
1605 ;;; left and right and not move forward. examining *lm-blackbox* | |
1606 ;;; revealed that there was no scent from the north and south | |
1607 ;;; landmarks, hence, they need less factoring down of the effect of | |
1608 ;;; distance on scent. | |
1609 | |
1610 (defun lm-set-landmark-signal-strengths () | |
1611 | |
1612 (setq lm-tree-r (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5)) | |
1613 | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1614 (mapc (lambda (direction) |
17905 | 1615 (put direction 'r (* lm-cx 1.1))) |
1616 lm-ew) | |
30888
e559f0aa6b2d
Don't quote lambda.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30542
diff
changeset
|
1617 (mapc (lambda (direction) |
17905 | 1618 (put direction 'r (* lm-cy 1.1))) |
1619 lm-ns) | |
1620 (put 'lm-tree 'r lm-tree-r)) | |
1621 | |
1622 | |
1623 ;;;_ + lm-test-run () | |
1624 | |
18951
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1625 ;;;###autoload |
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1626 (defalias 'landmark-repeat 'lm-test-run) |
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1627 ;;;###autoload |
17905 | 1628 (defun lm-test-run () |
18951
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1629 "Run 100 Lm games, each time saving the weights from the previous game." |
17905 | 1630 (interactive) |
1631 | |
1632 (lm 1) | |
1633 | |
1634 (dotimes (scratch-var 100) | |
1635 | |
1636 (lm 2))) | |
1637 | |
1638 | |
1639 ;;;_ + lm: The function you invoke to play | |
1640 | |
18951
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1641 ;;;###autoload |
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1642 (defalias 'landmark 'lm) |
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1643 ;;;###autoload |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1644 (defun lm (parg) |
18951
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1645 "Start or resume an Lm game. |
17905 | 1646 If a game is in progress, this command allows you to resume it. |
1647 Here is the relation between prefix args and game options: | |
1648 | |
1649 prefix arg | robot is auto-started | weights are saved from last game | |
1650 --------------------------------------------------------------------- | |
1651 none / 1 | yes | no | |
1652 2 | yes | yes | |
1653 3 | no | yes | |
1654 4 | no | no | |
1655 | |
18951
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1656 You start by moving to a square and typing \\[lm-start-robot], |
a1041ace6786
(landmark-repeat, landmark): New aliases.
Richard M. Stallman <rms@gnu.org>
parents:
18290
diff
changeset
|
1657 if you did not use a prefix arg to ask for automatic start. |
17905 | 1658 Use \\[describe-mode] for more info." |
37840
1e7b34ebbb0a
(lm): Use "p" not "P" for interactive spec.
Richard M. Stallman <rms@gnu.org>
parents:
34792
diff
changeset
|
1659 (interactive "p") |
17905 | 1660 |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1661 (setf lm-n nil lm-m nil) |
17905 | 1662 (lm-switch-to-window) |
1663 (cond | |
1664 (lm-emacs-is-computing | |
1665 (lm-crash-game)) | |
1666 ((or (not lm-game-in-progress) | |
1667 (<= lm-number-of-moves 2)) | |
1668 (let ((max-width (lm-max-width)) | |
1669 (max-height (lm-max-height))) | |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1670 (or lm-n (setq lm-n max-width)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1671 (or lm-m (setq lm-m max-height)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1672 (cond ((< lm-n 1) |
17905 | 1673 (error "I need at least 1 column")) |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1674 ((< lm-m 1) |
17905 | 1675 (error "I need at least 1 row")) |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1676 ((> lm-n max-width) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1677 (error "I cannot display %d columns in that window" lm-n))) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1678 (if (and (> lm-m max-height) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1679 (not (eq lm-m lm-saved-board-height)) |
17905 | 1680 ;; Use EQ because SAVED-BOARD-HEIGHT may be nil |
65689
96187e7edd1b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
65585
diff
changeset
|
1681 (not (y-or-n-p (format "Do you really want %d rows? " lm-m)))) |
18290
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1682 (setq lm-m max-height))) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1683 (if lm-one-moment-please |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1684 (message "One moment, please...")) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1685 (lm-start-game lm-n lm-m) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1686 (eval (cons 'lm-init |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1687 (cond |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1688 ((= parg 1) '(t nil)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1689 ((= parg 2) '(t t)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1690 ((= parg 3) '(nil t)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1691 ((= parg 4) '(nil nil)) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1692 (t '(nil t)))))))) |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1693 |
d87d578b953d
(lm-display-statistics): Display stats in mode line.
Karl Heuer <kwzh@gnu.org>
parents:
17970
diff
changeset
|
1694 |
17905 | 1695 ;;;_ + Local variables |
1696 | |
68866
5340157fbfc2
* files.el (safe-local-variable-values): New option.
Chong Yidong <cyd@stupidchicken.com>
parents:
68634
diff
changeset
|
1697 ;;; The following `allout-layout' local variable setting: |
17905 | 1698 ;;; - closes all topics from the first topic to just before the third-to-last, |
1699 ;;; - shows the children of the third to last (config vars) | |
1700 ;;; - and the second to last (code section), | |
1701 ;;; - and closes the last topic (this local-variables section). | |
1702 ;;;Local variables: | |
68866
5340157fbfc2
* files.el (safe-local-variable-values): New option.
Chong Yidong <cyd@stupidchicken.com>
parents:
68634
diff
changeset
|
1703 ;;;allout-layout: (0 : -1 -1 0) |
17905 | 1704 ;;;End: |
1705 | |
76953 | 1706 (random t) |
1707 | |
25227
d270a933be88
Provide `landmark', not `lm', and just once.
Karl Heuer <kwzh@gnu.org>
parents:
23376
diff
changeset
|
1708 (provide 'landmark) |
d270a933be88
Provide `landmark', not `lm', and just once.
Karl Heuer <kwzh@gnu.org>
parents:
23376
diff
changeset
|
1709 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
1710 ;; arch-tag: ae5031be-96e6-459e-a3df-1df53117d3f2 |
17905 | 1711 ;;; landmark.el ends here |