diff options
| author | Karl Heuer | 1997-06-18 04:23:02 +0000 |
|---|---|---|
| committer | Karl Heuer | 1997-06-18 04:23:02 +0000 |
| commit | a7b88742ffbcd58c1e76d7c41048af38320a796c (patch) | |
| tree | 6c1bebb6c91530a0ed43778aa064eb7ee50035a4 | |
| parent | e36a387ddd540c1b3427577db2ed1b1577014c9a (diff) | |
| download | emacs-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.el | 471 |
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. |
| 510 | square and the RIGHTth after SQUARE, along the DX, DY direction, considering | 513 | That is, those between the LEFTth square and the RIGHTth after SQUARE, |
| 511 | that DVAL has been added on SQUARE." | 514 | along 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. | ||
| 1100 | Affects a noise generator which was used in an earlier incarnation of | ||
| 1101 | this 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. | ||
| 1128 | The drawback of this is you don't see how many moves the last run took | ||
| 1129 | because it is overwritten by \"One moment please\".") | ||
| 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 | ||
| 1326 | earlier incarnation of this program to add a random element to the way | ||
| 1327 | moves 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.") |
| 1343 | wij. 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. |
| 1345 | w0j. used in the function lm-update-naught-weights" ) | 1259 | Used in the function lm-update-normal-weights.") |
| 1260 | (defvar lm-c-naught 0.5 | ||
| 1261 | "A factor applied to modulate the increase in w0j. | ||
| 1262 | Used 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 |
| 1349 | occurred 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. |
| 1350 | a rut for some reason") | 1267 | Used 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 |
| 1352 | cycles 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. |
| 1353 | is called to push him out of it") | 1270 | After 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. |
| 1736 | If a game is in progress, this command allows you to resume it. | 1628 | If a game is in progress, this command allows you to resume it. |
| 1737 | Here is the relation between prefix args and game options: | 1629 | Here 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 | ||
| 1746 | You start by moving to a square and typing \\[lm-start-robot]. | 1638 | You start by moving to a square and typing \\[lm-start-robot] |
| 1747 | Use \\[describe-mode] for more info." | 1639 | Use \\[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 |