Lines Matching +refs:lm +refs:noise
13 ;;; M-x lm-test-run
68 (defgroup lm nil
70 :prefix "lm-"
80 ;; leftmost topmost square has coords (1,1) and index lm-board-width + 2.
84 (defvar lm-board-width nil
86 (defvar lm-board-height nil
89 (defvar lm-board nil
92 (defvar lm-vector-length nil
93 "Length of lm-board vector.")
95 (defvar lm-draw-limit nil
99 (defvar lm-cx 0
102 (defvar lm-cy 0
105 (defvar lm-m 0
108 (defvar lm-n 0
112 (defun lm-xy-to-index (x y)
114 (+ (* y lm-board-width) x y))
116 (defun lm-index-to-x (index)
118 (% index (1+ lm-board-width)))
120 (defun lm-index-to-y (index)
122 (/ index (1+ lm-board-width)))
124 (defun lm-init-board ()
125 "Create the lm-board vector and fill it with initial values."
126 (setq lm-board (make-vector lm-vector-length 0))
128 (let ((i 0) (ii (1- lm-vector-length)))
129 (while (<= i lm-board-width) ; The squares in [0..width] and in
130 (aset lm-board i -1) ; [length - width - 1..length - 1]
131 (aset lm-board ii -1) ; are padding squares.
135 (while (< i lm-vector-length)
136 (aset lm-board i -1) ; and also all k*(width+1)
137 (setq i (+ i lm-board-width 1)))))
144 (defconst lm-square-width 2
147 (defconst lm-square-height 1
150 (defconst lm-x-offset 3
153 (defconst lm-y-offset 1
159 (defcustom lm-mode-hook nil
162 :group 'lm)
164 (defvar lm-mode-map nil
167 (if lm-mode-map nil
168 (setq lm-mode-map (make-sparse-keymap))
171 (define-key lm-mode-map "y" 'lm-move-nw) ; y
172 (define-key lm-mode-map "u" 'lm-move-ne) ; u
173 (define-key lm-mode-map "b" 'lm-move-sw) ; b
174 (define-key lm-mode-map "n" 'lm-move-se) ; n
175 (define-key lm-mode-map "h" 'backward-char) ; h
176 (define-key lm-mode-map "l" 'forward-char) ; l
177 (define-key lm-mode-map "j" 'lm-move-down) ; j
178 (define-key lm-mode-map "k" 'lm-move-up) ; k
180 (define-key lm-mode-map [kp-7] 'lm-move-nw)
181 (define-key lm-mode-map [kp-9] 'lm-move-ne)
182 (define-key lm-mode-map [kp-1] 'lm-move-sw)
183 (define-key lm-mode-map [kp-3] 'lm-move-se)
184 (define-key lm-mode-map [kp-4] 'backward-char)
185 (define-key lm-mode-map [kp-6] 'forward-char)
186 (define-key lm-mode-map [kp-2] 'lm-move-down)
187 (define-key lm-mode-map [kp-8] 'lm-move-up)
189 (define-key lm-mode-map "\C-n" 'lm-move-down) ; C-n
190 (define-key lm-mode-map "\C-p" 'lm-move-up) ; C-p
193 (define-key lm-mode-map "X" 'lm-human-plays) ; X
194 (define-key lm-mode-map "x" 'lm-human-plays) ; x
196 (define-key lm-mode-map " " 'lm-start-robot) ; SPC
197 (define-key lm-mode-map [down-mouse-1] 'lm-start-robot)
198 (define-key lm-mode-map [drag-mouse-1] 'lm-click)
199 (define-key lm-mode-map [mouse-1] 'lm-click)
200 (define-key lm-mode-map [down-mouse-2] 'lm-click)
201 (define-key lm-mode-map [mouse-2] 'lm-mouse-play)
202 (define-key lm-mode-map [drag-mouse-2] 'lm-mouse-play)
204 (define-key lm-mode-map [remap previous-line] 'lm-move-up)
205 (define-key lm-mode-map [remap next-line] 'lm-move-down)
206 (define-key lm-mode-map [remap beginning-of-line] 'lm-beginning-of-line)
207 (define-key lm-mode-map [remap end-of-line] 'lm-end-of-line)
208 (define-key lm-mode-map [remap undo] 'lm-human-takes-back)
209 (define-key lm-mode-map [remap advertised-undo] 'lm-human-takes-back))
211 (defvar lm-emacs-won ()
214 (defface lm-font-lock-face-O '((((class color)) :foreground "red")
218 :group 'lm)
220 (defface lm-font-lock-face-X '((((class color)) :foreground "green")
224 :group 'lm)
226 (defvar lm-font-lock-keywords
227 '(("O" . 'lm-font-lock-face-O)
228 ("X" . 'lm-font-lock-face-X)
229 ("[-|/\\]" 0 (if lm-emacs-won
230 'lm-font-lock-face-O
231 'lm-font-lock-face-X)))
234 (put 'lm-mode 'front-sticky
235 (put 'lm-mode 'rear-nonsticky '(intangible)))
236 (put 'lm-mode 'intangible 1)
239 (put 'lm-mode 'mode-class 'special)
241 (defun lm-mode ()
247 You play by moving the cursor over the square you choose and hitting \\[lm-human-plays].
250 \\{lm-mode-map}
251 Entry to this mode calls the value of `lm-mode-hook' if that value
255 (setq major-mode 'lm-mode
257 (lm-display-statistics)
258 (use-local-map lm-mode-map)
260 (setq font-lock-defaults '(lm-font-lock-keywords t))
262 (run-mode-hooks 'lm-mode-hook))
272 (defvar lm-score-table nil
342 (defconst lm-score-trans-table
359 (defconst lm-winning-threshold OOOOscore
362 (defconst lm-loosing-threshold XXXXscore
366 (defun lm-strongest-square ()
375 (square (lm-xy-to-index 1 1)) ; First square
376 (end (lm-xy-to-index lm-board-width lm-board-height))
381 ((< (aref lm-score-table square) score-max))
383 ((> (setq score (aref lm-score-table square)) score-max)
384 (if (zerop (aref lm-board square)) ; is it free ?
388 (aset lm-score-table square -1))) ; no: kill it !
390 ((not (zerop (aref lm-board square)))
391 (aset lm-score-table square -1))
410 (defvar lm-saved-score-table nil
413 (defvar lm-saved-board-width nil
416 (defvar lm-saved-board-height nil
420 (defun lm-init-score-table ()
422 (if (and lm-saved-score-table ; Has it been stored last time ?
423 (= lm-board-width lm-saved-board-width)
424 (= lm-board-height lm-saved-board-height))
425 (setq lm-score-table (copy-sequence lm-saved-score-table))
427 (setq lm-score-table
428 (make-vector lm-vector-length (* 20 nil-score)))
430 (setq maxi (/ (1+ lm-board-width) 2)
431 maxj (/ (1+ lm-board-height) 2)
443 (lm-init-square-score i j)
449 (lm-init-square-score i j)
452 (setq lm-saved-score-table (copy-sequence lm-score-table)
453 lm-saved-board-width lm-board-width
454 lm-saved-board-height lm-board-height)))
456 (defun lm-nb-qtuples (i j)
462 (right (min 4 (- lm-board-width i)))
464 (down (min 4 (- lm-board-height j))))
471 (defun lm-init-square-score (i j)
473 (let ((ii (1+ (- lm-board-width i)))
474 (jj (1+ (- lm-board-height j)))
475 (sc (* (lm-nb-qtuples i j) (aref lm-score-trans-table 0))))
476 (aset lm-score-table (lm-xy-to-index i j) sc)
477 (aset lm-score-table (lm-xy-to-index ii j) sc)
478 (aset lm-score-table (lm-xy-to-index i jj) sc)
479 (aset lm-score-table (lm-xy-to-index ii jj) sc)))
489 (defun lm-update-score-table (square dval)
497 (let* ((x (lm-index-to-x square))
498 (y (lm-index-to-y square))
501 (imax (min 0 (- lm-board-width x 4)))
502 (jmax (min 0 (- lm-board-height y 4))))
503 (lm-update-score-in-direction imin imax
505 (lm-update-score-in-direction jmin jmax
507 (lm-update-score-in-direction (max imin jmin) (min imax jmax)
509 (lm-update-score-in-direction (max (- 1 y) -4
510 (- x lm-board-width))
512 (- lm-board-height y 4))
515 (defun lm-update-score-in-direction (left right square dx dy dval)
526 (setq depl (lm-xy-to-index dx dy)
534 (setq count (+ count (aref lm-board square))
539 (setq delta (- (aref lm-score-trans-table count)
540 (aref lm-score-trans-table (- count dval))))
544 (if (zerop (aref lm-board square)) ; only for free squares
545 (aset lm-score-table square
546 (+ (aref lm-score-table square) delta)))
551 count (+ count (- (aref lm-board square0))
552 (aref lm-board square2))
564 (defvar lm-game-in-progress nil
567 (defvar lm-game-history nil
570 (defvar lm-number-of-moves nil
573 (defvar lm-number-of-human-moves nil
576 (defvar lm-emacs-played-first nil
579 (defvar lm-human-took-back nil
582 (defvar lm-human-refused-draw nil
585 (defvar lm-emacs-is-computing nil
590 (defun lm-start-game (n m)
592 (setq lm-emacs-is-computing t) ; Raise flag
593 (setq lm-game-in-progress t)
594 (setq lm-board-width n
595 lm-board-height m
596 lm-vector-length (1+ (* (+ m 2) (1+ n)))
597 lm-draw-limit (/ (* 7 n m) 10))
598 (setq lm-emacs-won nil
599 lm-game-history nil
600 lm-number-of-moves 0
601 lm-number-of-human-moves 0
602 lm-emacs-played-first nil
603 lm-human-took-back nil
604 lm-human-refused-draw nil)
605 (lm-init-display n m) ; Display first: the rest takes time
606 (lm-init-score-table) ; INIT-BOARD requires that the score
607 (lm-init-board) ; table be already created.
608 (setq lm-emacs-is-computing nil))
610 (defun lm-play-move (square val &optional dont-update-score)
612 (setq lm-emacs-is-computing t) ; Raise flag
614 (setq lm-number-of-human-moves (1+ lm-number-of-human-moves)))
615 ((zerop lm-number-of-moves) ; an Emacs move. Is it first ?
616 (setq lm-emacs-played-first t)))
617 (setq lm-game-history
618 (cons (cons square (aref lm-score-table square))
619 lm-game-history)
620 lm-number-of-moves (1+ lm-number-of-moves))
621 (lm-plot-square square val)
622 (aset lm-board square val) ; *BEFORE* UPDATE-SCORE !
624 (lm-update-score-table square val) ; previous val was 0: dval = val
625 (aset lm-score-table square -1))
626 (setq lm-emacs-is-computing nil))
628 (defun lm-take-back ()
630 (setq lm-emacs-is-computing t)
631 (let* ((last-move (car lm-game-history))
633 (oldval (aref lm-board square)))
635 (setq lm-number-of-human-moves (1- lm-number-of-human-moves)))
636 (setq lm-game-history (cdr lm-game-history)
637 lm-number-of-moves (1- lm-number-of-moves))
638 (lm-plot-square square 0)
639 (aset lm-board square 0) ; *BEFORE* UPDATE-SCORE !
640 (lm-update-score-table square (- oldval))
641 (aset lm-score-table square (cdr last-move)))
642 (setq lm-emacs-is-computing nil))
647 (defvar lm-number-of-trials 0
650 (defvar lm-sum-of-moves 0
653 (defvar lm-number-of-emacs-wins 0
656 (defvar lm-number-of-human-wins 0
659 (defvar lm-number-of-draws 0
663 (defun lm-terminate-game (result)
665 (setq lm-number-of-trials (1+ lm-number-of-trials))
666 (setq lm-sum-of-moves (+ lm-sum-of-moves lm-number-of-moves))
670 (lm-display-statistics)
672 (setq lm-game-in-progress nil))
674 (defun lm-crash-game ()
676 (setq lm-emacs-is-computing nil)
677 (lm-terminate-game 'crash-game)
679 (lm-prompt-for-other-game))
684 (defun lm-emacs-plays ()
687 (lm-switch-to-window)
689 (lm-emacs-is-computing
690 (lm-crash-game))
691 ((not lm-game-in-progress)
692 (lm-prompt-for-other-game))
696 (setq square (lm-strongest-square))
698 (lm-terminate-game 'nobody-won))
700 (setq score (aref lm-score-table square))
701 (lm-play-move square 6)
702 (cond ((>= score lm-winning-threshold)
703 (setq lm-emacs-won t) ; for font-lock
704 (lm-find-filled-qtuple square 6)
705 (lm-terminate-game 'emacs-won))
707 (lm-terminate-game 'nobody-won))
708 ((and (> lm-number-of-moves lm-draw-limit)
709 (not lm-human-refused-draw)
710 (lm-offer-a-draw))
711 (lm-terminate-game 'draw-agreed))
713 (lm-prompt-for-move)))))))))
717 (defun lm-click (click)
724 (lm-goto-xy
726 lm-x-offset
729 lm-square-width
730 (% lm-square-width 2)
731 (/ lm-square-width 2))
732 lm-square-width)
734 lm-board-width)
736 lm-y-offset
740 lm-square-height
741 (% lm-square-height 2)
742 (/ lm-square-height 2))
743 lm-square-height)
745 lm-board-height))))
747 (defun lm-mouse-play (click)
750 (if (lm-click click)
751 (lm-human-plays)))
753 (defun lm-human-plays ()
758 (lm-switch-to-window)
760 (lm-emacs-is-computing
761 (lm-crash-game))
762 ((not lm-game-in-progress)
763 (lm-prompt-for-other-game))
766 (setq square (lm-point-square))
769 ((not (zerop (aref lm-board square)))
772 (setq score (aref lm-score-table square))
773 (lm-play-move square 1)
774 (cond ((and (>= score lm-loosing-threshold)
778 (lm-find-filled-qtuple square 1))
779 (lm-terminate-game 'human-won))
781 (lm-emacs-plays)))))))))
783 (defun lm-human-takes-back ()
786 (lm-switch-to-window)
788 (lm-emacs-is-computing
789 (lm-crash-game))
790 ((not lm-game-in-progress)
793 (lm-prompt-for-other-game))
794 ((zerop lm-number-of-human-moves)
801 (setq lm-human-took-back t)
802 (let ((number lm-number-of-human-moves))
803 (while (= number lm-number-of-human-moves)
804 (lm-take-back)))
805 (lm-prompt-for-move))))
807 (defun lm-human-resigns ()
810 (lm-switch-to-window)
812 (lm-emacs-is-computing
813 (lm-crash-game))
814 ((not lm-game-in-progress)
817 (lm-terminate-game 'human-resigned))
819 (lm-prompt-for-move))
821 (lm-terminate-game 'human-resigned)))) ; OK. Accept it
825 (defun lm-prompt-for-move ()
827 (message (if (zerop lm-number-of-human-moves)
834 (defun lm-prompt-for-other-game ()
838 (lm 2)
839 (lm 1))
842 (defun lm-offer-a-draw ()
845 (not (setq lm-human-refused-draw t))))
848 (defun lm-max-width ()
851 lm-x-offset lm-x-offset 1)
852 lm-square-width)))
854 (defun lm-max-height ()
857 lm-y-offset lm-y-offset 2)
859 lm-square-height)))
861 (defun lm-point-y ()
864 (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1))
865 lm-square-height))))
867 (defun lm-point-square ()
870 (lm-xy-to-index (1+ (/ (- (current-column) lm-x-offset)
871 lm-square-width))
872 (lm-point-y))))
874 (defun lm-goto-square (index)
876 (lm-goto-xy (lm-index-to-x index) (lm-index-to-y index)))
878 (defun lm-goto-xy (x y)
881 (goto-line (+ 1 lm-y-offset (* lm-square-height (1- y)))))
882 (move-to-column (+ lm-x-offset (* lm-square-width (1- x)))))
884 (defun lm-plot-square (square value)
887 (lm-goto-square square))
906 (defun lm-init-display (n m)
915 (if (zerop (% lm-x-offset lm-square-width))
916 lm-square-width
917 (max (/ (+ (% lm-x-offset lm-square-width)
918 lm-square-width 1) 2) 2)))
920 (newline lm-y-offset)
923 x (- lm-x-offset lm-square-width))
925 (insert-char ?\t (/ (- (setq x (+ x lm-square-width))
946 (insert-char ?\n lm-square-height))
954 (put-text-property (point-min) (point) 'category 'lm-mode))
955 (lm-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
958 (defun lm-display-statistics ()
964 lm-number-of-trials
965 (if (zerop lm-number-of-trials)
967 (/ lm-sum-of-moves lm-number-of-trials))))
970 (defun lm-switch-to-window ()
976 (if lm-game-in-progress
977 (lm-crash-game)) ; buffer has been killed or something
979 (lm-mode))))
989 (defun lm-find-filled-qtuple (square value)
991 (or (lm-check-filled-qtuple square value 1 0)
992 (lm-check-filled-qtuple square value 0 1)
993 (lm-check-filled-qtuple square value 1 1)
994 (lm-check-filled-qtuple square value -1 1)))
996 (defun lm-check-filled-qtuple (square value dx dy)
1000 (depl (lm-xy-to-index dx dy)))
1002 (= value (aref lm-board (setq left (- left depl)))))
1005 (= value (aref lm-board (setq right (+ right depl)))))
1008 (lm-cross-qtuple (+ square (* a depl)) (+ square (* b depl))
1012 (defun lm-cross-qtuple (square1 square2 dx dy)
1015 (let ((depl (lm-xy-to-index dx dy))
1020 (lm-goto-square square1)
1025 (insert-char ?- (1- lm-square-width) t)
1030 (let ((lm-n 1)
1032 (while (< lm-n lm-square-height)
1033 (setq lm-n (1+ lm-n))
1038 (indent-to (prog1 (- (current-column) (/ lm-square-width 2))
1039 (forward-line (/ lm-square-height 2))))
1042 (indent-to (prog1 (+ (current-column) (/ lm-square-width 2))
1043 (forward-line (/ lm-square-height 2))))
1051 (defun lm-move-down ()
1054 (if (< (lm-point-y) lm-board-height)
1055 (next-line 1)));;; lm-square-height)))
1057 (defun lm-move-up ()
1060 (if (> (lm-point-y) 1)
1061 (previous-line lm-square-height)))
1063 (defun lm-move-ne ()
1066 (lm-move-up)
1069 (defun lm-move-se ()
1072 (lm-move-down)
1075 (defun lm-move-nw ()
1078 (lm-move-up)
1081 (defun lm-move-sw ()
1084 (lm-move-down)
1087 (defun lm-beginning-of-line ()
1090 (move-to-column lm-x-offset))
1092 (defun lm-end-of-line ()
1095 (move-to-column (+ lm-x-offset
1096 (* lm-square-width (1- lm-board-width)))))
1101 ;;;_ - lm-nvar
1102 (defvar lm-nvar 0.0075
1104 Affects a noise generator which was used in an earlier incarnation of
1108 (defvar lm-ns '(lm-n lm-s)
1110 (defvar lm-ew '(lm-e lm-w)
1112 (defvar lm-directions '(lm-n lm-s lm-e lm-w)
1114 (defvar lm-8-directions
1115 '((lm-n) (lm-n lm-w) (lm-w) (lm-s lm-w)
1116 (lm-s) (lm-s lm-e) (lm-e) (lm-n lm-e))
1119 (defvar lm-number-of-moves
1123 ;;;_* Terry's mods to create lm.el
1125 ;;;(setq lm-debug nil)
1126 (defvar lm-debug nil
1128 (defcustom lm-one-moment-please nil
1133 :group 'lm)
1134 (defcustom lm-output-moves t
1137 :group 'lm)
1140 (defun lm-weights-debug ()
1141 (if lm-debug
1142 (progn (lm-print-wts) (lm-blackbox) (lm-print-y,s,noise)
1143 (lm-print-smell))))
1146 (defun lm-print-distance-int (direction)
1151 (defun lm-print-distance ()
1152 (insert (format "tree: %S \n" (calc-distance-of-robot-from 'lm-tree)))
1153 (mapc 'lm-print-distance-int lm-directions))
1156 ;;(setq direction 'lm-n)
1157 ;;(get 'lm-n 'lm-s)
1158 (defun lm-nslify-wts-int (direction)
1161 lm-directions))
1164 (defun lm-nslify-wts ()
1166 (let ((l (apply 'append (mapcar 'lm-nslify-wts-int lm-directions))))
1171 (defun lm-print-wts-int (direction)
1177 lm-directions)
1180 (defun lm-print-wts ()
1183 (set-buffer "*lm-wts*")
1185 (mapc 'lm-print-wts-int lm-directions)))
1187 (defun lm-print-moves (moves)
1190 (set-buffer "*lm-moves*")
1194 (defun lm-print-y,s,noise-int (direction)
1195 (insert (format "%S:lm-y %S, s %S, noise %S \n"
1199 (get direction 'noise)
1202 (defun lm-print-y,s,noise ()
1205 (set-buffer "*lm-y,s,noise*")
1207 (mapc 'lm-print-y,s,noise-int lm-directions)))
1209 (defun lm-print-smell-int (direction)
1214 (defun lm-print-smell ()
1217 (set-buffer "*lm-smell*")
1220 (mapc 'lm-print-smell-int lm-directions)))
1222 (defun lm-print-w0-int (direction)
1227 (defun lm-print-w0 ()
1230 (set-buffer "*lm-w0*")
1232 (mapc 'lm-print-w0-int lm-directions)))
1234 (defun lm-blackbox ()
1236 (set-buffer "*lm-blackbox*")
1242 lm-directions)
1249 lm-directions)
1251 (lm-print-wts-blackbox)
1253 (lm-print-distance)
1256 (defun lm-print-wts-blackbox ()
1258 (mapc 'lm-print-wts-int lm-directions))
1261 (defcustom lm-bound 0.005
1264 :group 'lm)
1265 (defcustom lm-c 1.0
1267 Used in the function lm-update-normal-weights."
1269 :group 'lm)
1270 (defcustom lm-c-naught 0.5
1272 Used in the function lm-update-naught-weights."
1274 :group 'lm)
1275 (defvar lm-initial-w0 0.0)
1276 (defvar lm-initial-wij 0.0)
1277 (defcustom lm-no-payoff 0
1281 :group 'lm)
1282 (defcustom lm-max-stall-time 2
1284 After this limit is reached, lm-random-move is called to push him out of it."
1286 :group 'lm)
1290 ;;;_ - lm-flip-a-coin ()
1291 (defun lm-flip-a-coin ()
1295 ;;;_ : lm-very-small-random-number ()
1296 ;(defun lm-very-small-random-number ()
1299 ;;;_ : lm-randomize-weights-for (direction)
1300 (defun lm-randomize-weights-for (direction)
1304 (* (lm-flip-a-coin) (/ (random 10000) 10000.0))))
1305 lm-directions))
1306 ;;;_ : lm-noise ()
1307 (defun lm-noise ()
1308 (* (- (/ (random 30001) 15000.0) 1) lm-nvar))
1310 ;;;_ : lm-fix-weights-for (direction)
1311 (defun lm-fix-weights-for (direction)
1315 lm-initial-wij))
1316 lm-directions))
1320 ;;;_ - lm-plot-internal (sym)
1321 (defun lm-plot-internal (sym)
1322 (lm-plot-square (lm-xy-to-index
1326 ;;;_ - lm-plot-landmarks ()
1327 (defun lm-plot-landmarks ()
1328 (setq lm-cx (/ lm-board-width 2))
1329 (setq lm-cy (/ lm-board-height 2))
1331 (put 'lm-n 'x lm-cx)
1332 (put 'lm-n 'y 1)
1333 (put 'lm-n 'sym 2)
1335 (put 'lm-tree 'x lm-cx)
1336 (put 'lm-tree 'y lm-cy)
1337 (put 'lm-tree 'sym 6)
1339 (put 'lm-s 'x lm-cx)
1340 (put 'lm-s 'y lm-board-height)
1341 (put 'lm-s 'sym 3)
1343 (put 'lm-w 'x 1)
1344 (put 'lm-w 'y (/ lm-board-height 2))
1345 (put 'lm-w 'sym 5)
1347 (put 'lm-e 'x lm-board-width)
1348 (put 'lm-e 'y (/ lm-board-height 2))
1349 (put 'lm-e 'sym 4)
1351 (mapc 'lm-plot-internal '(lm-n lm-s lm-e lm-w lm-tree)))
1368 (lm-index-to-x (lm-point-square))
1370 (lm-index-to-y (lm-point-square)))))
1382 (defun lm-f (x)
1384 ((> x lm-bound) lm-bound)
1388 (defun lm-y (direction)
1389 (let ((noise (put direction 'noise (lm-noise))))
1395 (defun lm-update-normal-weights (direction)
1400 (* lm-c
1404 lm-directions))
1406 (defun lm-update-naught-weights (direction)
1409 (lm-f
1412 (* lm-c-naught
1415 lm-directions))
1420 (defun lm-calc-current-smells ()
1423 lm-directions))
1425 (defun lm-calc-payoff ()
1427 (put 'z 't (calc-smell-internal 'lm-tree))
1429 (incf lm-no-payoff)
1430 (setf lm-no-payoff 0)))
1432 (defun lm-store-old-y_t ()
1435 lm-directions))
1440 (defun lm-confidence-for (target-direction)
1447 lm-directions)))
1450 (defun lm-calc-confidences ()
1452 (put direction 's (lm-confidence-for direction)))
1453 lm-directions))
1455 (defun lm-move ()
1456 (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0))
1458 (mapc (lambda (dir) (put dir 'y_t 0)) lm-ns)
1459 (if lm-debug
1461 (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0))
1463 (mapc (lambda (dir) (put dir 'y_t 0)) lm-ew)
1464 (if lm-debug
1471 (lm-n lm-move-up)
1472 (lm-s lm-move-down)
1473 (lm-e forward-char)
1474 (lm-w backward-char)))
1475 (lm-plot-square (lm-point-square) 1)
1476 (incf lm-number-of-moves)
1477 (if lm-output-moves
1478 (message "Moves made: %d" lm-number-of-moves)))
1481 (defun lm-random-move ()
1484 lm-directions)
1485 (dolist (direction (nth (random 8) lm-8-directions))
1487 (lm-move))
1489 (defun lm-amble-robot ()
1491 (while (> (calc-distance-of-robot-from 'lm-tree) 0)
1493 (lm-store-old-y_t)
1494 (lm-calc-current-smells)
1496 (if (> lm-no-payoff lm-max-stall-time)
1497 (lm-random-move)
1499 (lm-calc-confidences)
1500 (mapc 'lm-y lm-directions)
1501 (lm-move)))
1503 (lm-calc-payoff)
1505 (mapc 'lm-update-normal-weights lm-directions)
1506 (mapc 'lm-update-naught-weights lm-directions)
1507 (if lm-debug
1508 (lm-weights-debug)))
1509 (lm-terminate-game nil))
1512 ;;;_ - lm-start-robot ()
1513 (defun lm-start-robot ()
1518 (lm-switch-to-window)
1520 (lm-emacs-is-computing
1521 (lm-crash-game))
1522 ((not lm-game-in-progress)
1523 (lm-prompt-for-other-game))
1526 (setq square (lm-point-square))
1529 ((not (zerop (aref lm-board square)))
1533 (lm-plot-square square 1)
1535 (lm-store-old-y_t)
1536 (lm-calc-current-smells)
1537 (put 'z 't (calc-smell-internal 'lm-tree))
1539 (lm-random-move)
1541 (lm-calc-payoff)
1543 (mapc 'lm-update-normal-weights lm-directions)
1544 (mapc 'lm-update-naught-weights lm-directions)
1545 (lm-amble-robot)
1550 ;;;_ - lm-init (auto-start save-weights)
1551 (defvar lm-tree-r "")
1553 (defun lm-init (auto-start save-weights)
1555 (setq lm-number-of-moves 0)
1557 (lm-plot-landmarks)
1559 (if lm-debug
1562 (set-buffer (get-buffer-create "*lm-w0*"))
1564 (set-buffer (get-buffer-create "*lm-moves*"))
1565 (set-buffer (get-buffer-create "*lm-wts*"))
1567 (set-buffer (get-buffer-create "*lm-y,s,noise*"))
1569 (set-buffer (get-buffer-create "*lm-smell*"))
1571 (set-buffer (get-buffer-create "*lm-blackbox*"))
1573 (set-buffer (get-buffer-create "*lm-distance*"))
1577 (lm-set-landmark-signal-strengths)
1581 lm-directions)
1585 (mapc 'lm-fix-weights-for lm-directions)
1587 (put direction 'w0 lm-initial-w0))
1588 lm-directions))
1593 (lm-goto-xy (1+ (random lm-board-width)) (1+ (random lm-board-height)))
1594 (lm-start-robot))))
1599 ;(defum lm-sum-list (list)
1601 ; (+ (car list) (lm-sum-list (cdr list)))
1605 ;;;_ - lm-set-landmark-signal-strengths ()
1607 ;;; left and right and not move forward. examining *lm-blackbox*
1612 (defun lm-set-landmark-signal-strengths ()
1614 (setq lm-tree-r (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5))
1617 (put direction 'r (* lm-cx 1.1)))
1618 lm-ew)
1620 (put direction 'r (* lm-cy 1.1)))
1621 lm-ns)
1622 (put 'lm-tree 'r lm-tree-r))
1625 ;;;_ + lm-test-run ()
1628 (defalias 'landmark-repeat 'lm-test-run)
1630 (defun lm-test-run ()
1634 (lm 1)
1638 (lm 2)))
1641 ;;;_ + lm: The function you invoke to play
1644 (defalias 'landmark 'lm)
1646 (defun lm (parg)
1658 You start by moving to a square and typing \\[lm-start-robot],
1663 (setf lm-n nil lm-m nil)
1664 (lm-switch-to-window)
1666 (lm-emacs-is-computing
1667 (lm-crash-game))
1668 ((or (not lm-game-in-progress)
1669 (<= lm-number-of-moves 2))
1670 (let ((max-width (lm-max-width))
1671 (max-height (lm-max-height)))
1672 (or lm-n (setq lm-n max-width))
1673 (or lm-m (setq lm-m max-height))
1674 (cond ((< lm-n 1)
1676 ((< lm-m 1)
1678 ((> lm-n max-width)
1679 (error "I cannot display %d columns in that window" lm-n)))
1680 (if (and (> lm-m max-height)
1681 (not (eq lm-m lm-saved-board-height))
1683 (not (y-or-n-p (format "Do you really want %d rows? " lm-m))))
1684 (setq lm-m max-height)))
1685 (if lm-one-moment-please
1687 (lm-start-game lm-n lm-m)
1688 (eval (cons 'lm-init