-
Notifications
You must be signed in to change notification settings - Fork 0
/
logic.lisp
119 lines (89 loc) · 3.8 KB
/
logic.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
;;; logic.lisp --- some useful functions adapted from PAIP
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see http://www.gnu.org/licenses/.
;;; Licensed material:
;; Some functions in this file are originally written by Peter Norvig
;; for his book "Paradigms of Artificial Intelligence
;; Programming". The modified versions are redistributed here under
;; the terms of the General Public License as given above.
;; You can find more information on Norvig's book at his website:
;; http://www.norvig.com/paip.html
;; The full license for the PAIP code, which governs the terms of
;; said redistribution under the GPL, can be found at norvig.com:
;; http://www.norvig.com/license.html
(in-package :blocky)
;;; Miscellaneous
(defmacro callf (function place &rest arguments)
`(setf ,place (apply #',function ,place (list ,@arguments))))
;;; Grammars
;; http://en.wikipedia.org/wiki/Context-free_grammar
;; Generate random sentences from context-free grammars, and then
;; interpret them how you want.
(defvar *grammar* nil
"The current context-free grammar used for sentence generation.
This is an association list of the form:
((VARIABLE >> EXPANSIONS)
(VARIABLE >> EXPANSIONS)
...)
Where EXPANSIONS is a list of alternatives, each of which may be
either (1) single symbols or (2) a list of symbols, representing
concatenation.")
(defun one-of (set)
(list (nth (random (length set)) set)))
(defun left-hand-side (rule)
(first rule))
(defun right-hand-side (rule)
(rest (rest rule)))
(defun expansions (variable)
(right-hand-side (assoc variable *grammar*)))
(defun generate (phrase)
"Generate a random phrase using the grammar in `*grammar*'."
(cond ((listp phrase)
(apply #'append (mapcar #'generate phrase)))
((expansions phrase)
(generate (one-of (expansions phrase))))
(t (list phrase))))
;;; Memoization facility
(defmacro defun-memo (name args memo-args &body body)
"Define a memoized function named NAME.
ARGS is the lambda list giving the memoized function's arguments.
MEMO-ARGS is a list with optional keyword arguments for the
memoization process: :KEY, :VALIDATOR, and :TEST."
`(memoize (defun ,name ,args . ,body) ,@memo-args))
(defun memo (fn &key (key #'first) (test #'eql) validator name)
"Return a memo-function of fn."
(let ((table (make-hash-table :test test)))
(setf (get name 'memo) table)
#'(lambda (&rest args)
(let ((k (funcall key args)))
(multiple-value-bind (val found-p)
(gethash k table)
(if found-p
val
;; only cache if value is valid
(let ((candidate-value (apply fn args)))
(prog1 candidate-value
(when (or (null validator)
(funcall validator candidate-value))
(setf (gethash k table) candidate-value))))))))))
(defun memoize (fn-name &key (key #'first) (test #'eql) validator)
"Replace fn-name's global definition with a memoized version."
(clear-memoize fn-name)
(setf (symbol-function fn-name)
(memo (symbol-function fn-name)
:name fn-name :key key :test test :validator validator)))
(defun clear-memoize (fn-name)
"Clear the hash table from a memo function."
(let ((table (get fn-name 'memo)))
(when table (clrhash table))))
(defun get-memo-table (fn-name)
(get fn-name 'memo))
;;; logic.lisp ends here