aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKarl Heuer1997-06-18 04:23:02 +0000
committerKarl Heuer1997-06-18 04:23:02 +0000
commita7b88742ffbcd58c1e76d7c41048af38320a796c (patch)
tree6c1bebb6c91530a0ed43778aa064eb7ee50035a4
parente36a387ddd540c1b3427577db2ed1b1577014c9a (diff)
downloademacs-a7b88742ffbcd58c1e76d7c41048af38320a796c.tar.gz
emacs-a7b88742ffbcd58c1e76d7c41048af38320a796c.zip
(lm-display-statistics): Display stats in mode line.
(lm-number-of-trials, lm-sum-of-moves): New vars. Various doc fixes.
-rw-r--r--lisp/play/landmark.el471
1 files changed, 182 insertions, 289 deletions
diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el
index ebe16e16b0c..292e2252e99 100644
--- a/lisp/play/landmark.el
+++ b/lisp/play/landmark.el
@@ -1,10 +1,17 @@
1;;;_landmark.el --- Landmark learning neural network 1;;;_ landmark.el --- neural-network robot that learns landmarks
2;; Copyright (C) 1996 Free Software Foundation, Inc. 2
3;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
3 4
4;; Author: Terrence Brannon <brannon@rana.usc.edu> 5;; Author: Terrence Brannon <brannon@rana.usc.edu>
5;; Created: December 16, 1996 - first release to usenet 6;; Created: December 16, 1996 - first release to usenet
6;; Keywords: gomoku neural network adaptive search chemotaxis 7;; Keywords: gomoku neural network adaptive search chemotaxis
7 8
9;;;_* Usage
10;;; Just type
11;;; M-x eval-current-buffer
12;;; M-x lm-test-run
13
14
8;; This file is part of GNU Emacs. 15;; This file is part of GNU Emacs.
9 16
10;; GNU Emacs is free software; you can redistribute it and/or modify 17;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -22,10 +29,6 @@
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 29;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA. 30;; Boston, MA 02111-1307, USA.
24 31
25;;;_* Usage
26;;; Just type
27;;; M-x eval-current-buffer
28;;; M-x lm-test-run
29 32
30;;;_* Commentary 33;;;_* Commentary
31;;; Lm is a relatively non-participatory game in which a robot 34;;; Lm is a relatively non-participatory game in which a robot
@@ -36,7 +39,7 @@
36;;; future. If the smell of the tree decreases, the robots weights are 39;;; future. If the smell of the tree decreases, the robots weights are
37;;; adjusted to discourage a correct move. 40;;; adjusted to discourage a correct move.
38 41
39;;; In layman's terms, the search space is initially flat. The point 42;;; In laymen's terms, the search space is initially flat. The point
40;;; of training is to "turn up the edges of the search space" so that 43;;; of training is to "turn up the edges of the search space" so that
41;;; the robot rolls toward the center. 44;;; the robot rolls toward the center.
42 45
@@ -52,45 +55,21 @@
52;;; west will be improved when they shouldn't 55;;; west will be improved when they shouldn't
53 56
54;;; For further references see 57;;; For further references see
55;;; http://rana.usc.edu:8376/~yuri/CS564/hw5.html 58;;; http://rana.usc.edu:8376/~brannon/warez/yours-truly/lm/
56 59;;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this
57 60;;; concise problem description.
58
59
60
61
62
63
64
65
66 61
67;;;_* Provide 62;;;_* Provide
68 63
69(provide 'lm) 64(provide 'lm)
70 65
71
72
73
74
75
76
77;;;_* Require 66;;;_* Require
78(require 'cl) 67(require 'cl)
79 68
80
81
82
83
84
85;;;_* From Gomoku 69;;;_* From Gomoku
86 70
87
88
89
90
91;;;_ + THE BOARD. 71;;;_ + THE BOARD.
92 72
93
94;; The board is a rectangular grid. We code empty squares with 0, X's with 1 73;; The board is a rectangular grid. We code empty squares with 0, X's with 1
95;; and O's with 6. The rectangle is recorded in a one dimensional vector 74;; and O's with 6. The rectangle is recorded in a one dimensional vector
96;; containing padding squares (coded with -1). These squares allow us to 75;; containing padding squares (coded with -1). These squares allow us to
@@ -115,6 +94,19 @@
115 ;; This is usually set to 70% of the number of squares. 94 ;; This is usually set to 70% of the number of squares.
116 "After how many moves will Emacs offer a draw?") 95 "After how many moves will Emacs offer a draw?")
117 96
97(defvar lm-cx 0
98 "This is the x coordinate of the center of the board.")
99
100(defvar lm-cy 0
101 "This is the y coordinate of the center of the board.")
102
103(defvar lm-m 0
104 "This is the x dimension of the playing board.")
105
106(defvar lm-n 0
107 "This is the y dimension of the playing board.")
108
109
118(defun lm-xy-to-index (x y) 110(defun lm-xy-to-index (x y)
119 "Translate X, Y cartesian coords into the corresponding board index." 111 "Translate X, Y cartesian coords into the corresponding board index."
120 (+ (* y lm-board-width) x y)) 112 (+ (* y lm-board-width) x y))
@@ -142,8 +134,22 @@
142 (aset lm-board i -1) ; and also all k*(width+1) 134 (aset lm-board i -1) ; and also all k*(width+1)
143 (setq i (+ i lm-board-width 1))))) 135 (setq i (+ i lm-board-width 1)))))
144 136
137;;;_ + DISPLAYING THE BOARD.
145 138
139;; You may change these values if you have a small screen or if the squares
140;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
141
142(defconst lm-square-width 2
143 "*Horizontal spacing between squares on the Lm board.")
144
145(defconst lm-square-height 1
146 "*Vertical spacing between squares on the Lm board.")
147
148(defconst lm-x-offset 3
149 "*Number of columns between the Lm board and the side of the window.")
146 150
151(defconst lm-y-offset 1
152 "*Number of lines between the Lm board and the top of the window.")
147 153
148 154
149;;;_ + LM MODE AND KEYMAP. 155;;;_ + LM MODE AND KEYMAP.
@@ -252,9 +258,6 @@ is non-nil. One interesting value is `turn-on-font-lock'."
252 (run-hooks 'lm-mode-hook)) 258 (run-hooks 'lm-mode-hook))
253 259
254 260
255
256
257
258;;;_ + THE SCORE TABLE. 261;;;_ + THE SCORE TABLE.
259 262
260 263
@@ -506,9 +509,9 @@ is non-nil. One interesting value is `turn-on-font-lock'."
506 square -1 1 dval))) 509 square -1 1 dval)))
507 510
508(defun lm-update-score-in-direction (left right square dx dy dval) 511(defun lm-update-score-in-direction (left right square dx dy dval)
509 "Update scores for all squares in the qtuples starting between the LEFTth 512 "Update scores for all squares in the qtuples in range.
510square and the RIGHTth after SQUARE, along the DX, DY direction, considering 513That is, those between the LEFTth square and the RIGHTth after SQUARE,
511that DVAL has been added on SQUARE." 514along the DX, DY direction, considering that DVAL has been added on SQUARE."
512 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well 515 ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well
513 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that 516 ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that
514 ;; DX,DY direction. 517 ;; DX,DY direction.
@@ -588,12 +591,12 @@ that DVAL has been added on SQUARE."
588 lm-board-height m 591 lm-board-height m
589 lm-vector-length (1+ (* (+ m 2) (1+ n))) 592 lm-vector-length (1+ (* (+ m 2) (1+ n)))
590 lm-draw-limit (/ (* 7 n m) 10)) 593 lm-draw-limit (/ (* 7 n m) 10))
591 (setq lm-emacs-won nil 594 (setq lm-emacs-won nil
592 lm-game-history nil 595 lm-game-history nil
593 lm-number-of-moves 0 596 lm-number-of-moves 0
594 lm-number-of-human-moves 0 597 lm-number-of-human-moves 0
595 lm-emacs-played-first nil 598 lm-emacs-played-first nil
596 lm-human-took-back nil 599 lm-human-took-back nil
597 lm-human-refused-draw nil) 600 lm-human-refused-draw nil)
598 (lm-init-display n m) ; Display first: the rest takes time 601 (lm-init-display n m) ; Display first: the rest takes time
599 (lm-init-score-table) ; INIT-BOARD requires that the score 602 (lm-init-score-table) ; INIT-BOARD requires that the score
@@ -635,9 +638,13 @@ that DVAL has been added on SQUARE."
635 (setq lm-emacs-is-computing nil)) 638 (setq lm-emacs-is-computing nil))
636 639
637 640
638
639;;;_ + SESSION CONTROL. 641;;;_ + SESSION CONTROL.
640 642
643(defvar lm-number-of-trials 0
644 "The number of times that landmark has been run.")
645
646(defvar lm-sum-of-moves 0
647 "The total number of moves made in all games.")
641 648
642(defvar lm-number-of-emacs-wins 0 649(defvar lm-number-of-emacs-wins 0
643 "Number of games Emacs won in this session.") 650 "Number of games Emacs won in this session.")
@@ -651,55 +658,11 @@ that DVAL has been added on SQUARE."
651 658
652(defun lm-terminate-game (result) 659(defun lm-terminate-game (result)
653 "Terminate the current game with RESULT." 660 "Terminate the current game with RESULT."
654 (message 661 (setq lm-number-of-trials (1+ lm-number-of-trials))
655 (cond 662 (setq lm-sum-of-moves (+ lm-sum-of-moves lm-number-of-moves))
656 ((eq result 'emacs-won) 663 (if (eq result 'crash-game)
657 (setq lm-number-of-emacs-wins (1+ lm-number-of-emacs-wins)) 664 (message
658 (cond ((< lm-number-of-moves 20) 665 "Sorry, I have been interrupted and cannot resume that game..."))
659 "This was a REALLY QUICK win.")
660 (lm-human-refused-draw
661 "I won... Too bad you refused my offer of a draw !")
662 (lm-human-took-back
663 "I won... Taking moves back will not help you !")
664 ((not lm-emacs-played-first)
665 "I won... Playing first did not help you much !")
666 ((and (zerop lm-number-of-human-wins)
667 (zerop lm-number-of-draws)
668 (> lm-number-of-emacs-wins 1))
669 "I'm becoming tired of winning...")
670 ("I won.")))
671 ((eq result 'human-won)
672 (setq lm-number-of-human-wins (1+ lm-number-of-human-wins))
673 (concat "OK, you won this one."
674 (cond
675 (lm-human-took-back
676 " I, for one, never take my moves back...")
677 (lm-emacs-played-first
678 ".. so what ?")
679 (" Now, let me play first just once."))))
680 ((eq result 'human-resigned)
681 (setq lm-number-of-emacs-wins (1+ lm-number-of-emacs-wins))
682 "So you resign. That's just one more win for me.")
683 ((eq result 'nobody-won)
684 (setq lm-number-of-draws (1+ lm-number-of-draws))
685 (concat "This is a draw. "
686 (cond
687 (lm-human-took-back
688 "I, for one, never take my moves back...")
689 (lm-emacs-played-first
690 "Just chance, I guess.")
691 ("Now, let me play first just once."))))
692 ((eq result 'draw-agreed)
693 (setq lm-number-of-draws (1+ lm-number-of-draws))
694 (concat "Draw agreed. "
695 (cond
696 (lm-human-took-back
697 "I, for one, never take my moves back...")
698 (lm-emacs-played-first
699 "You were lucky.")
700 ("Now, let me play first just once."))))
701 ((eq result 'crash-game)
702 "Sorry, I have been interrupted and cannot resume that game...")))
703 (lm-display-statistics) 666 (lm-display-statistics)
704 ;;(ding) 667 ;;(ding)
705 (setq lm-game-in-progress nil)) 668 (setq lm-game-in-progress nil))
@@ -712,13 +675,8 @@ that DVAL has been added on SQUARE."
712 (lm-prompt-for-other-game)) 675 (lm-prompt-for-other-game))
713 676
714 677
715
716
717
718;;;_ + INTERACTIVE COMMANDS. 678;;;_ + INTERACTIVE COMMANDS.
719 679
720
721
722(defun lm-emacs-plays () 680(defun lm-emacs-plays ()
723 "Compute Emacs next move and play it." 681 "Compute Emacs next move and play it."
724 (interactive) 682 (interactive)
@@ -781,7 +739,7 @@ that DVAL has been added on SQUARE."
781 lm-square-height) 739 lm-square-height)
782 1) 740 1)
783 lm-board-height)))) 741 lm-board-height))))
784 742
785(defun lm-mouse-play (click) 743(defun lm-mouse-play (click)
786 "Play at the square where you click." 744 "Play at the square where you click."
787 (interactive "e") 745 (interactive "e")
@@ -858,8 +816,6 @@ If the game is finished, this command requests for another game."
858 (t 816 (t
859 (lm-terminate-game 'human-resigned)))) ; OK. Accept it 817 (lm-terminate-game 'human-resigned)))) ; OK. Accept it
860 818
861
862
863;;;_ + PROMPTING THE HUMAN PLAYER. 819;;;_ + PROMPTING THE HUMAN PLAYER.
864 820
865(defun lm-prompt-for-move () 821(defun lm-prompt-for-move ()
@@ -874,34 +830,17 @@ If the game is finished, this command requests for another game."
874(defun lm-prompt-for-other-game () 830(defun lm-prompt-for-other-game ()
875 "Ask for another game, and start it." 831 "Ask for another game, and start it."
876 (if (y-or-n-p "Another game ") 832 (if (y-or-n-p "Another game ")
877 (lm lm-board-width lm-board-height) 833 (if (y-or-n-p "Retain learned weights ")
834 (lm 2)
835 (lm 1))
878 (message "Chicken !"))) 836 (message "Chicken !")))
879 837
880(defun lm-offer-a-draw () 838(defun lm-offer-a-draw ()
881 "Offer a draw and return T if Human accepted it." 839 "Offer a draw and return t if Human accepted it."
882 (or (y-or-n-p "I offer you a draw. Do you accept it ") 840 (or (y-or-n-p "I offer you a draw. Do you accept it ")
883 (not (setq lm-human-refused-draw t)))) 841 (not (setq lm-human-refused-draw t))))
884 842
885 843
886
887;;;_ + DISPLAYING THE BOARD.
888
889;; You may change these values if you have a small screen or if the squares
890;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
891
892(defconst lm-square-width 2
893 "*Horizontal spacing between squares on the Lm board.")
894
895(defconst lm-square-height 1
896 "*Vertical spacing between squares on the Lm board.")
897
898(defconst lm-x-offset 3
899 "*Number of columns between the Lm board and the side of the window.")
900
901(defconst lm-y-offset 1
902 "*Number of lines between the Lm board and the top of the window.")
903
904
905(defun lm-max-width () 844(defun lm-max-width ()
906 "Largest possible board width for the current window." 845 "Largest possible board width for the current window."
907 (1+ (/ (- (window-width (selected-window)) 846 (1+ (/ (- (window-width (selected-window))
@@ -920,13 +859,6 @@ If the game is finished, this command requests for another game."
920 (let ((inhibit-point-motion-hooks t)) 859 (let ((inhibit-point-motion-hooks t))
921 (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1)) 860 (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1))
922 lm-square-height)))) 861 lm-square-height))))
923(defun my-lm-point-y ()
924 (interactive)
925 "Return the board row where point is."
926 (let ((inhibit-point-motion-hooks t))
927 (message (format "%S"
928 (1+ (/ (- (count-lines 1 (point)) lm-y-offset (if (bolp) 0 1))
929 lm-square-height))))))
930 862
931(defun lm-point-square () 863(defun lm-point-square ()
932 "Return the index of the square point is on." 864 "Return the index of the square point is on."
@@ -1022,12 +954,11 @@ If the game is finished, this command requests for another game."
1022 ;; We store this string in the mode-line-process local variable. 954 ;; We store this string in the mode-line-process local variable.
1023 ;; This is certainly not the cleanest way out ... 955 ;; This is certainly not the cleanest way out ...
1024 (setq mode-line-process 956 (setq mode-line-process
1025 (format ": Won %d, lost %d%s" 957 (format ": Trials: %d, Avg#Moves: %d"
1026 lm-number-of-human-wins 958 lm-number-of-trials
1027 lm-number-of-emacs-wins 959 (if (zerop lm-number-of-trials)
1028 (if (zerop lm-number-of-draws) 960 0
1029 "" 961 (/ lm-sum-of-moves lm-number-of-trials))))
1030 (format ", drew %d" lm-number-of-draws))))
1031 (force-mode-line-update)) 962 (force-mode-line-update))
1032 963
1033(defun lm-switch-to-window () 964(defun lm-switch-to-window ()
@@ -1042,7 +973,6 @@ If the game is finished, this command requests for another game."
1042 (lm-mode)))) 973 (lm-mode))))
1043 974
1044 975
1045
1046;;;_ + CROSSING WINNING QTUPLES. 976;;;_ + CROSSING WINNING QTUPLES.
1047 977
1048;; When someone succeeds in filling a qtuple, we draw a line over the five 978;; When someone succeeds in filling a qtuple, we draw a line over the five
@@ -1051,14 +981,14 @@ If the game is finished, this command requests for another game."
1051;; who won. The solution is to scan the board along all four directions. 981;; who won. The solution is to scan the board along all four directions.
1052 982
1053(defun lm-find-filled-qtuple (square value) 983(defun lm-find-filled-qtuple (square value)
1054 "Return T if SQUARE belongs to a qtuple filled with VALUEs." 984 "Return t if SQUARE belongs to a qtuple filled with VALUEs."
1055 (or (lm-check-filled-qtuple square value 1 0) 985 (or (lm-check-filled-qtuple square value 1 0)
1056 (lm-check-filled-qtuple square value 0 1) 986 (lm-check-filled-qtuple square value 0 1)
1057 (lm-check-filled-qtuple square value 1 1) 987 (lm-check-filled-qtuple square value 1 1)
1058 (lm-check-filled-qtuple square value -1 1))) 988 (lm-check-filled-qtuple square value -1 1)))
1059 989
1060(defun lm-check-filled-qtuple (square value dx dy) 990(defun lm-check-filled-qtuple (square value dx dy)
1061 "Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY." 991 "Return t if SQUARE belongs to a qtuple filled with VALUEs along DX, DY."
1062 (let ((a 0) (b 0) 992 (let ((a 0) (b 0)
1063 (left square) (right square) 993 (left square) (right square)
1064 (depl (lm-xy-to-index dx dy))) 994 (depl (lm-xy-to-index dx dy)))
@@ -1091,10 +1021,10 @@ If the game is finished, this command requests for another game."
1091 (skip-chars-forward " \t") 1021 (skip-chars-forward " \t")
1092 (point)))) 1022 (point))))
1093 ((= dx 0) ; Vertical 1023 ((= dx 0) ; Vertical
1094 (let ((n 1) 1024 (let ((lm-n 1)
1095 (column (current-column))) 1025 (column (current-column)))
1096 (while (< n lm-square-height) 1026 (while (< lm-n lm-square-height)
1097 (setq n (1+ n)) 1027 (setq lm-n (1+ lm-n))
1098 (forward-line 1) 1028 (forward-line 1)
1099 (indent-to column) 1029 (indent-to column)
1100 (insert-and-inherit ?|)))) 1030 (insert-and-inherit ?|))))
@@ -1109,7 +1039,6 @@ If the game is finished, this command requests for another game."
1109 (sit-for 0)) ; Display NOW 1039 (sit-for 0)) ; Display NOW
1110 1040
1111 1041
1112
1113;;;_ + CURSOR MOTION. 1042;;;_ + CURSOR MOTION.
1114 1043
1115;; previous-line and next-line don't work right with intangible newlines 1044;; previous-line and next-line don't work right with intangible newlines
@@ -1162,43 +1091,50 @@ If the game is finished, this command requests for another game."
1162 1091
1163(provide 'lm) 1092(provide 'lm)
1164 1093
1165
1166(defun lm-xy-to-index (x y)
1167 "Translate X, Y cartesian coords into the corresponding board index."
1168 (+ (* y lm-board-width) x y))
1169
1170(defun lm-index-to-x (index)
1171 "Return corresponding x-coord of board INDEX."
1172 (% index (1+ lm-board-width)))
1173
1174(defun lm-index-to-y (index)
1175 "Return corresponding y-coord of board INDEX."
1176 (/ index (1+ lm-board-width)))
1177
1178
1179
1180
1181
1182 1094
1095;;;_ + Simulation variables
1183 1096
1097;;;_ - lm-nvar
1098(defvar lm-nvar 0.0075
1099 "Not used.
1100Affects a noise generator which was used in an earlier incarnation of
1101this program to add a random element to the way moves were made.")
1102;;;_ - lists of cardinal directions
1103;;;_ :
1104(defvar lm-ns '(lm-n lm-s)
1105 "Used when doing something relative to the north and south axes.")
1106(defvar lm-ew '(lm-e lm-w)
1107 "Used when doing something relative to the east and west axes.")
1108(defvar lm-directions '(lm-n lm-s lm-e lm-w)
1109 "The cardinal directions.")
1110(defvar lm-8-directions
1111 '((lm-n) (lm-n lm-w) (lm-w) (lm-s lm-w)
1112 (lm-s) (lm-s lm-e) (lm-e) (lm-n lm-e))
1113 "The full 8 possible directions.")
1114
1115(defvar lm-number-of-moves
1116 "The number of moves made by the robot so far.")
1184 1117
1185 1118
1186;;;_* Terry's mods to create lm.el 1119;;;_* Terry's mods to create lm.el
1187 1120
1188
1189
1190
1191
1192;;;_ + Debugging things 1121;;;_ + Debugging things
1193(setq debug-on-error t) 1122(setq debug-on-error t)
1194;;;(setq lm-debug nil) 1123;;;(setq lm-debug nil)
1195(setq lm-debug t) 1124(defvar lm-debug nil
1125 "If non-nil, debugging is printed.")
1126(defvar lm-one-moment-please nil
1127 "If non-nil, print \"One moment please\" when a new board is generated.
1128The drawback of this is you don't see how many moves the last run took
1129because it is overwritten by \"One moment please\".")
1130(defvar lm-output-moves t
1131 "If non-nil, output number of moves so far on a move-by-move basis.")
1196 1132
1197(defun lm-maybe-debug ()
1198 1133
1199 (if lm-debug 1134(defun lm-weights-debug ()
1200 (progn (lm-print-wts) (lm-blackbox) (lm-print-y,s,noise) 1135 (if lm-debug
1201 (lm-print-smell)))) 1136 (progn (lm-print-wts) (lm-blackbox) (lm-print-y,s,noise)
1137 (lm-print-smell))))
1202 1138
1203;;;_ - Printing various things 1139;;;_ - Printing various things
1204(defun lm-print-distance-int (direction) 1140(defun lm-print-distance-int (direction)
@@ -1315,47 +1251,23 @@ If the game is finished, this command requests for another game."
1315 (interactive) 1251 (interactive)
1316 (mapc 'lm-print-wts-int lm-directions)) 1252 (mapc 'lm-print-wts-int lm-directions))
1317 1253
1318
1319
1320
1321
1322;;;_ + Simulation variables
1323
1324;;;_ - lm-nvar
1325(defvar lm-nvar 0.0075 "affects a noise generator which was used in an
1326earlier incarnation of this program to add a random element to the way
1327moves were made. not used")
1328;;;_ - lists of cardinal directions
1329;;;_ :
1330(defvar lm-ns '(lm-n lm-s) "used when doing something relative to the
1331 north and south axes")
1332(defvar lm-ew '(lm-e lm-w) "used when doing something relative to the
1333 north and south axes")
1334(defvar lm-directions '(lm-n lm-s lm-e lm-w) "the cardinal directions")
1335(defvar lm-8-directions '(
1336 (lm-n) (lm-n lm-w) (lm-s)
1337 (lm-s lm-w) (lm-e) (lm-s lm-e)
1338 (lm-n lm-w) (lm-w))
1339 "the full 8 possible directions.")
1340;;;_ - learning parameters 1254;;;_ - learning parameters
1341(defvar lm-bound 0.005 "the maximum that w0j may be.") 1255(defvar lm-bound 0.005
1342(defvar lm-c 1.0 "a factor applied to modulate the increase in 1256 "The maximum that w0j may be.")
1343wij. used in the function lm-update-normal-weights") 1257(defvar lm-c 1.0
1344(defvar lm-c-naught 0.5 "a factor applied to modulate the increase in 1258 "A factor applied to modulate the increase in wij.
1345w0j. used in the function lm-update-naught-weights" ) 1259Used in the function lm-update-normal-weights.")
1260(defvar lm-c-naught 0.5
1261 "A factor applied to modulate the increase in w0j.
1262Used in the function lm-update-naught-weights.")
1346(defvar lm-initial-w0 0.0) 1263(defvar lm-initial-w0 0.0)
1347(defvar lm-initial-wij 0.0) 1264(defvar lm-initial-wij 0.0)
1348(defvar lm-no-payoff 0 "the amount of simulation cycles that have 1265(defvar lm-no-payoff 0
1349occurred with no movement. used to move the robot when he is stuck in 1266 "The amount of simulation cycles that have occurred with no movement.
1350a rut for some reason") 1267Used to move the robot when he is stuck in a rut for some reason.")
1351(defvar lm-max-stall-time 3 "the maximum of amount of simulation 1268(defvar lm-max-stall-time 2
1352cycles that the robot can get stuck in a place before lm-random-move 1269 "The maximum number of cycles that the robot can remain stuck in a place.
1353is called to push him out of it") 1270After this limit is reached, lm-random-move is called to push him out of it.")
1354
1355
1356
1357
1358
1359 1271
1360 1272
1361;;;_ + Randomizing functions 1273;;;_ + Randomizing functions
@@ -1365,45 +1277,33 @@ is called to push him out of it")
1365 -1 1277 -1
1366 1)) 1278 1))
1367;;;_ : lm-very-small-random-number () 1279;;;_ : lm-very-small-random-number ()
1368(defun lm-very-small-random-number () 1280;(defun lm-very-small-random-number ()
1369 (/ 1281; (/
1370 (* (/ (random 900000) 900000.0) .0001))) 1282; (* (/ (random 900000) 900000.0) .0001)))
1371;;;_ : lm-randomize-weights-for (direction) 1283;;;_ : lm-randomize-weights-for (direction)
1372(defun lm-randomize-weights-for (direction) 1284(defun lm-randomize-weights-for (direction)
1373 (mapc '(lambda (target-direction) 1285 (mapc '(lambda (target-direction)
1374 (put direction 1286 (put direction
1375 target-direction 1287 target-direction
1376 (* (lm-flip-a-coin) (/ (random 10000) 10000.0)))) 1288 (* (lm-flip-a-coin) (/ (random 10000) 10000.0))))
1377 lm-directions)) 1289 lm-directions))
1378;;;_ : lm-noise () 1290;;;_ : lm-noise ()
1379(defun lm-noise () 1291(defun lm-noise ()
1380 (* (- (/ (random 30001) 15000.0) 1) lm-nvar)) 1292 (* (- (/ (random 30001) 15000.0) 1) lm-nvar))
1381 1293
1382(defun lm-randomize-weights-for (direction)
1383 (mapc '(lambda (target-direction)
1384 (put direction
1385 target-direction
1386 (* (lm-flip-a-coin) (/ (random 10000) 10000.0))))
1387 lm-directions))
1388
1389
1390
1391
1392;;;_ : lm-fix-weights-for (direction) 1294;;;_ : lm-fix-weights-for (direction)
1393(defun lm-fix-weights-for (direction) 1295(defun lm-fix-weights-for (direction)
1394 (mapc '(lambda (target-direction) 1296 (mapc '(lambda (target-direction)
1395 (put direction 1297 (put direction
1396 target-direction 1298 target-direction
1397 lm-initial-wij)) 1299 lm-initial-wij))
1398 lm-directions)) 1300 lm-directions))
1399
1400
1401 1301
1402 1302
1403;;;_ + Plotting functions 1303;;;_ + Plotting functions
1404;;;_ - lm-plot-internal (sym) 1304;;;_ - lm-plot-internal (sym)
1405(defun lm-plot-internal (sym) 1305(defun lm-plot-internal (sym)
1406 (lm-plot-square (lm-xy-to-index 1306 (lm-plot-square (lm-xy-to-index
1407 (get sym 'x) 1307 (get sym 'x)
1408 (get sym 'y)) 1308 (get sym 'y))
1409 (get sym 'sym))) 1309 (get sym 'sym)))
@@ -1412,8 +1312,8 @@ is called to push him out of it")
1412 (setq lm-cx (/ lm-board-width 2)) 1312 (setq lm-cx (/ lm-board-width 2))
1413 (setq lm-cy (/ lm-board-height 2)) 1313 (setq lm-cy (/ lm-board-height 2))
1414 1314
1415 (put 'lm-n 'x lm-cx) 1315 (put 'lm-n 'x lm-cx)
1416 (put 'lm-n 'y 1) 1316 (put 'lm-n 'y 1)
1417 (put 'lm-n 'sym 2) 1317 (put 'lm-n 'sym 2)
1418 1318
1419 (put 'lm-tree 'x lm-cx) 1319 (put 'lm-tree 'x lm-cx)
@@ -1462,10 +1362,9 @@ is called to push him out of it")
1462 0))) 1362 0)))
1463 1363
1464 1364
1465
1466;;;_ + Learning (neural) functions 1365;;;_ + Learning (neural) functions
1467(defun lm-f (x) 1366(defun lm-f (x)
1468 (cond 1367 (cond
1469 ((> x lm-bound) lm-bound) 1368 ((> x lm-bound) lm-bound)
1470 ((< x 0.0) 0.0) 1369 ((< x 0.0) 0.0)
1471 (t x))) 1370 (t x)))
@@ -1482,29 +1381,28 @@ is called to push him out of it")
1482 (put direction target-direction 1381 (put direction target-direction
1483 (+ 1382 (+
1484 (get direction target-direction) 1383 (get direction target-direction)
1485 (* lm-c 1384 (* lm-c
1486 (- (get 'z 't) (get 'z 't-1)) 1385 (- (get 'z 't) (get 'z 't-1))
1487 (get target-direction 'y_t) 1386 (get target-direction 'y_t)
1488 (get direction 'smell))))) 1387 (get direction 'smell)))))
1489 lm-directions)) 1388 lm-directions))
1490 1389
1491(defun lm-update-naught-weights (direction) 1390(defun lm-update-naught-weights (direction)
1492 (mapc '(lambda (target-direction) 1391 (mapc '(lambda (target-direction)
1493 (put direction 'w0 1392 (put direction 'w0
1494 (lm-f 1393 (lm-f
1495 (+ 1394 (+
1496 (get direction 'w0) 1395 (get direction 'w0)
1497 (* lm-c-naught 1396 (* lm-c-naught
1498 (- (get 'z 't) (get 'z 't-1)) 1397 (- (get 'z 't) (get 'z 't-1))
1499 (get direction 'y_t)))))) 1398 (get direction 'y_t))))))
1500 lm-directions)) 1399 lm-directions))
1501 1400
1502 1401
1503
1504;;;_ + Statistics gathering and creating functions 1402;;;_ + Statistics gathering and creating functions
1505 1403
1506(defun lm-calc-current-smells () 1404(defun lm-calc-current-smells ()
1507 (mapc '(lambda (direction) 1405 (mapc '(lambda (direction)
1508 (put direction 'smell (calc-smell-internal direction))) 1406 (put direction 'smell (calc-smell-internal direction)))
1509 lm-directions)) 1407 lm-directions))
1510 1408
@@ -1516,21 +1414,19 @@ is called to push him out of it")
1516 (setf lm-no-payoff 0))) 1414 (setf lm-no-payoff 0)))
1517 1415
1518(defun lm-store-old-y_t () 1416(defun lm-store-old-y_t ()
1519 (mapc '(lambda (direction) 1417 (mapc '(lambda (direction)
1520 (put direction 'y_t-1 (get direction 'y_t))) 1418 (put direction 'y_t-1 (get direction 'y_t)))
1521 lm-directions)) 1419 lm-directions))
1522 1420
1523 1421
1524 1422;;;_ + Functions to move robot
1525;;;_ + Functions to move robot
1526
1527 1423
1528(defun lm-confidence-for (target-direction) 1424(defun lm-confidence-for (target-direction)
1529 (+ 1425 (+
1530 (get target-direction 'w0) 1426 (get target-direction 'w0)
1531 (reduce '+ 1427 (reduce '+
1532 (mapcar '(lambda (direction) 1428 (mapcar '(lambda (direction)
1533 (* 1429 (*
1534 (get direction target-direction) 1430 (get direction target-direction)
1535 (get direction 'smell)) 1431 (get direction 'smell))
1536 ) 1432 )
@@ -1538,7 +1434,7 @@ is called to push him out of it")
1538 1434
1539 1435
1540(defun lm-calc-confidences () 1436(defun lm-calc-confidences ()
1541 (mapc '(lambda (direction) 1437 (mapc '(lambda (direction)
1542 (put direction 's (lm-confidence-for direction))) 1438 (put direction 's (lm-confidence-for direction)))
1543 lm-directions)) 1439 lm-directions))
1544 1440
@@ -1546,11 +1442,13 @@ is called to push him out of it")
1546 (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0)) 1442 (if (and (= (get 'lm-n 'y_t) 1.0) (= (get 'lm-s 'y_t) 1.0))
1547 (progn 1443 (progn
1548 (mapc '(lambda (dir) (put dir 'y_t 0)) lm-ns) 1444 (mapc '(lambda (dir) (put dir 'y_t 0)) lm-ns)
1549 (message "n-s normalization."))) 1445 (if lm-debug
1446 (message "n-s normalization."))))
1550 (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0)) 1447 (if (and (= (get 'lm-w 'y_t) 1.0) (= (get 'lm-e 'y_t) 1.0))
1551 (progn 1448 (progn
1552 (mapc '(lambda (dir) (put dir 'y_t 0)) lm-ew) 1449 (mapc '(lambda (dir) (put dir 'y_t 0)) lm-ew)
1553 (message "e-w normalization"))) 1450 (if lm-debug
1451 (message "e-w normalization"))))
1554 1452
1555 (mapc '(lambda (pair) 1453 (mapc '(lambda (pair)
1556 (if (> (get (car pair) 'y_t) 0) 1454 (if (> (get (car pair) 'y_t) 0)
@@ -1561,11 +1459,13 @@ is called to push him out of it")
1561 (lm-e forward-char) 1459 (lm-e forward-char)
1562 (lm-w backward-char))) 1460 (lm-w backward-char)))
1563 (lm-plot-square (lm-point-square) 1) 1461 (lm-plot-square (lm-point-square) 1)
1564 (incf lm-moves)) 1462 (incf lm-number-of-moves)
1463 (if lm-output-moves
1464 (message (format "Moves made: %d" lm-number-of-moves))))
1565 1465
1566 1466
1567(defun lm-random-move () 1467(defun lm-random-move ()
1568 (mapc 1468 (mapc
1569 '(lambda (direction) (put direction 'y_t 0)) 1469 '(lambda (direction) (put direction 'y_t 0))
1570 lm-directions) 1470 lm-directions)
1571 (dolist (direction (nth (random 8) lm-8-directions)) 1471 (dolist (direction (nth (random 8) lm-8-directions))
@@ -1590,12 +1490,10 @@ is called to push him out of it")
1590 1490
1591 (mapc 'lm-update-normal-weights lm-directions) 1491 (mapc 'lm-update-normal-weights lm-directions)
1592 (mapc 'lm-update-naught-weights lm-directions) 1492 (mapc 'lm-update-naught-weights lm-directions)
1593 (lm-maybe-debug))
1594
1595 (let ((lm-res-str (format "%S moves." lm-moves)))
1596 (if lm-debug 1493 (if lm-debug
1597 (lm-print-moves lm-res-str)) 1494 (lm-weights-debug)))
1598 (message (format "%S moves." lm-moves)))) 1495 (lm-terminate-game nil))
1496
1599 1497
1600;;;_ - lm-start-robot () 1498;;;_ - lm-start-robot ()
1601(defun lm-start-robot () 1499(defun lm-start-robot ()
@@ -1630,17 +1528,17 @@ If the game is finished, this command requests for another game."
1630 1528
1631 (mapc 'lm-update-normal-weights lm-directions) 1529 (mapc 'lm-update-normal-weights lm-directions)
1632 (mapc 'lm-update-naught-weights lm-directions) 1530 (mapc 'lm-update-naught-weights lm-directions)
1633 (lm-maybe-debug)
1634 (lm-amble-robot) 1531 (lm-amble-robot)
1635 ))))))) 1532 )))))))
1636 1533
1637 1534
1638
1639;;;_ + Misc functions 1535;;;_ + Misc functions
1640;;;_ - lm-init (auto-start save-weights) 1536;;;_ - lm-init (auto-start save-weights)
1537(defvar lm-tree-r "")
1538
1641(defun lm-init (auto-start save-weights) 1539(defun lm-init (auto-start save-weights)
1642 1540
1643 (setq lm-moves 0) 1541 (setq lm-number-of-moves 0)
1644 1542
1645 (lm-plot-landmarks) 1543 (lm-plot-landmarks)
1646 1544
@@ -1680,8 +1578,7 @@ If the game is finished, this command requests for another game."
1680 (progn 1578 (progn
1681 (lm-goto-xy (1+ (random lm-board-width)) (1+ (random lm-board-height))) 1579 (lm-goto-xy (1+ (random lm-board-width)) (1+ (random lm-board-height)))
1682 (lm-start-robot)))) 1580 (lm-start-robot))))
1683 1581
1684
1685 1582
1686;;;_ - something which doesn't work 1583;;;_ - something which doesn't work
1687; no-a-worka!! 1584; no-a-worka!!
@@ -1702,18 +1599,15 @@ If the game is finished, this command requests for another game."
1702 1599
1703 (setq lm-tree-r (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5)) 1600 (setq lm-tree-r (* (sqrt (+ (square lm-cx) (square lm-cy))) 1.5))
1704 1601
1705 (mapc '(lambda (direction) 1602 (mapc '(lambda (direction)
1706 (put direction 'r (* lm-cx 1.1))) 1603 (put direction 'r (* lm-cx 1.1)))
1707 lm-ew) 1604 lm-ew)
1708 (mapc '(lambda (direction) 1605 (mapc '(lambda (direction)
1709 (put direction 'r (* lm-cy 1.1))) 1606 (put direction 'r (* lm-cy 1.1)))
1710 lm-ns) 1607 lm-ns)
1711 (put 'lm-tree 'r lm-tree-r)) 1608 (put 'lm-tree 'r lm-tree-r))
1712 1609
1713 1610
1714
1715
1716
1717;;;_ + lm-test-run () 1611;;;_ + lm-test-run ()
1718 1612
1719(defun lm-test-run () 1613(defun lm-test-run ()
@@ -1727,11 +1621,9 @@ If the game is finished, this command requests for another game."
1727 (lm 2))) 1621 (lm 2)))
1728 1622
1729 1623
1730
1731;;;_ + lm: The function you invoke to play 1624;;;_ + lm: The function you invoke to play
1732 1625
1733;;;###autoload 1626(defun lm (parg)
1734(defun landmark (parg)
1735 "Start an Lm game. 1627 "Start an Lm game.
1736If a game is in progress, this command allows you to resume it. 1628If a game is in progress, this command allows you to resume it.
1737Here is the relation between prefix args and game options: 1629Here is the relation between prefix args and game options:
@@ -1743,11 +1635,11 @@ none / 1 | yes | no
1743 3 | no | yes 1635 3 | no | yes
1744 4 | no | no 1636 4 | no | no
1745 1637
1746You start by moving to a square and typing \\[lm-start-robot]. 1638You start by moving to a square and typing \\[lm-start-robot]
1747Use \\[describe-mode] for more info." 1639Use \\[describe-mode] for more info."
1748 (interactive "p") 1640 (interactive "p")
1749 1641
1750 (setf n nil m nil) 1642 (setf lm-n nil lm-m nil)
1751 (lm-switch-to-window) 1643 (lm-switch-to-window)
1752 (cond 1644 (cond
1753 (lm-emacs-is-computing 1645 (lm-emacs-is-computing
@@ -1756,29 +1648,31 @@ Use \\[describe-mode] for more info."
1756 (<= lm-number-of-moves 2)) 1648 (<= lm-number-of-moves 2))
1757 (let ((max-width (lm-max-width)) 1649 (let ((max-width (lm-max-width))
1758 (max-height (lm-max-height))) 1650 (max-height (lm-max-height)))
1759 (or n (setq n max-width)) 1651 (or lm-n (setq lm-n max-width))
1760 (or m (setq m max-height)) 1652 (or lm-m (setq lm-m max-height))
1761 (cond ((< n 1) 1653 (cond ((< lm-n 1)
1762 (error "I need at least 1 column")) 1654 (error "I need at least 1 column"))
1763 ((< m 1) 1655 ((< lm-m 1)
1764 (error "I need at least 1 row")) 1656 (error "I need at least 1 row"))
1765 ((> n max-width) 1657 ((> lm-n max-width)
1766 (error "I cannot display %d columns in that window" n))) 1658 (error "I cannot display %d columns in that window" lm-n)))
1767 (if (and (> m max-height) 1659 (if (and (> lm-m max-height)
1768 (not (eq m lm-saved-board-height)) 1660 (not (eq lm-m lm-saved-board-height))
1769 ;; Use EQ because SAVED-BOARD-HEIGHT may be nil 1661 ;; Use EQ because SAVED-BOARD-HEIGHT may be nil
1770 (not (y-or-n-p (format "Do you really want %d rows " m)))) 1662 (not (y-or-n-p (format "Do you really want %d rows " lm-m))))
1771 (setq m max-height))) 1663 (setq lm-m max-height)))
1772 (message "One moment, please...") 1664 (if lm-one-moment-please
1773 (lm-start-game n m))) 1665 (message "One moment, please..."))
1774 (eval (cons 'lm-init 1666 (lm-start-game lm-n lm-m)
1775 (cond 1667 (eval (cons 'lm-init
1776 ((= parg 1) '(t nil)) 1668 (cond
1777 ((= parg 2) '(t t)) 1669 ((= parg 1) '(t nil))
1778 ((= parg 3) '(nil t)) 1670 ((= parg 2) '(t t))
1779 ((= parg 4) '(nil nil)) 1671 ((= parg 3) '(nil t))
1780 (t '(nil t)))))) 1672 ((= parg 4) '(nil nil))
1781 1673 (t '(nil t))))))))
1674
1675
1782;;;_ + Local variables 1676;;;_ + Local variables
1783 1677
1784;;; The following `outline-layout' local variable setting: 1678;;; The following `outline-layout' local variable setting:
@@ -1790,5 +1684,4 @@ Use \\[describe-mode] for more info."
1790;;;outline-layout: (0 : -1 -1 0) 1684;;;outline-layout: (0 : -1 -1 0)
1791;;;End: 1685;;;End:
1792 1686
1793
1794;;; landmark.el ends here 1687;;; landmark.el ends here