とりあえず進む。ソース主体な章なので、コメント方式で。例によって、日本語のコメントは私。それ以外はNorvig。ただしソースは写経なので間違えてたらごめんなさい。
;;; 7.1 Translating English into Equations
;;; STUDENTの仕様
;;;
;;; 1. 入力を句に分解する。句は等式を表すものとする。
;;; 2. 句を等号で結ばれたペアに変換する。
;;; 3. 2の句をさらに分解して、数と変数を要素とする四則演算となるようにする。
;;; 4. rule-based translatorを用いて英語の句を数式に変換する。
;;; 5. 4の数式群について変数の値を求める。
;;; 6. 5の結果を出力する。
(defstruct (rule (:type list)) pattern response)
(defstruct (exp (:type list)
(:constructor mkexp (lhs op rhs)))
op lhs rhs)
(defun exp-p (x) (consp x))
;; conspだけでexp-pとしちゃっていいの？
(defun exp-args (x) (rest x))
(pat-match-abbrev '?x* '(?* ?x))
(pat-match-abbrev '?y* '(?* ?y))
(defparameter *student-rules* (mapcar #'expand-pat-match-abbrev
'(((?x* |.|) ?x)
((?x* |.| ?y*) (?x ?y))
((if ?x* |,| then ?y*) (?x ?y))
((if ?x* then ?y*) (?x ?y))
((if ?x* |,| ?y*) (?x ?y))
((if ?x* |,| and ?y*) (?x ?y))
((?x* |,| and ?y*) (?x ?y))
((find ?x* and ?y*) ((= to-find-1 ?x) (= to-find-2 ?y)))
((find ?x*) (= to-find ?x))
((?x* equals ?y*) (= ?x ?y))
((?x* same as ?y*) (= ?x ?y))
((?x* = ?y*) (= ?x ?y))
((?x* is equal to ?y*) (= ?x ?y))
((?x* is ?y*) (= ?x ?y))
((?x* - ?y*) (- ?x ?y))
((?x* minus ?y*) (- ?x ?y))
((difference between ?x* and ?y*) (- ?y ?x))
((difference ?x* and ?y*) (- ?y ?x))
((?x* + ?y*) (+ ?x ?y))
((?x* plus ?y*) (+ ?x ?y))
((sum ?x* and ?y*) (+ ?x ?y))
((product ?x* and ?y*) (* ?x ?y))
((?x* * ?y*) (* ?x ?y))
((?x* / ?y*) (/ ?x ?y))
((?x* per ?y*) (/ ?x ?y))
((?x* divided by ?y*) (/ ?x ?y))
((half ?x*) (/ ?x 2))
((one half ?x*) (/ ?x 2))
((twice ?x*) (* 2 ?x))
((square ?x*) (* ?x ?x))
((?x* % less than ?y*) (* ?y (/ (- 100 ?x) 100)))
((?x* % more than ?y*) (* ?y (/ (+ 100 ?x) 100)))
((?x* % ?y*) (* (/ ?x 100) ?y)))))
(defun student (words)
"Solve certain Algebra Word Problems."
(solve-equations
(create-list-of-equations
(tranlate-to-expression (remove-if #'noise-word-p words)))))
;; words : 例 (If z is 3 |,| what is twice z)
(defun translate-to-expression (words)
"Translate an English phrase into an equation or expression."
(or (rule-based-translator
words *student-rules*
:rule-if #'rule-pattern :rule-then #'rule-response
:action #'(lambda (bindings response)
(sublis (mapcar #'translate-pair bindings)
response)))
(make-variable words)))
;; words : 例 (If z is 3 |,| what is twice z)
;;
;; rule-based-translator の引数仕様は、次のよう。
;; INPUT RULES &KEY (MATCHER (quote PAT-MATCH)) (RULE-IF (function FIRST)) (RULE-THEN (function REST)) (ACTION (function SUBLIS)))
;; INPUT RULESは字句通り。
;; matcherはpat-match。
;; :rule-ifと:rule-thenの、#'rule-patternと#'rule-responseはELIZAのものである、としておく。
;; :actionは、(funcall action result (funcall rule-then rule))であり、マッチしたときにbindingsとrule-thenを
;; 使って、どう変換しますか、ということだった。ここでは#'tranlate-pairを使うのが特徴。
;;
;; rule-based-translatorがfailしたときは、make-variableを呼ぶ。
(defun translate-pair (pair)
"Translate the value part of the pair into an equation or expression."
(cons (binding-var pair)
(translate-to-expression (binding-val pair))))
;; ここ、再帰になっている。
;; pair : bindingsの中の1要素。例 '(var . val)
;; valがまだ変換可能なものかもしれないので、それを実施。
;; 結果としては、another pairを返すだけ。ただし、valはもう分解可能な構造を含まないものになっている。
(defun create-list-of-equations (exp)
"Separate out equations embeded in nested parens."
(cond ((null exp) nil)
((atom (first exp)) (list exp))
(t (append (create-list-of-equations (first exp))
(create-list-of-equations (rest exp))))))
;; 動作例で理解する。
#+test (create-list-of-equations nil) ;-> nil
#+test (create-list-of-equations 'a) ;-> error
#+test (create-list-of-equations '(a)) ;-> '((A))
#+test (create-list-of-equations '(a b)) ;-> '((A B))
#+test (create-list-of-equations '(a (b))) ;-> '((A (B)))
#+test (create-list-of-equations '((a) b)) ;-> '(((A) (B)))
#+test (create-list-of-equations
'((a) (b c) ((d e) f))) ;-> '((A) (B C) (D E) (F))
(defun make-variable (words)
"Create a variable name based on the given list of words"
;; The list of words will already have noise words removed
(first words))
;; これはtranslate-to-expressionの中で呼ばれている。
;; しかし、これが意味があるのは、translate-pairのなかでtranslate-to-expressionを読んでいるところだろう。
;; translate-pairの中で、valが分解不可能なときに、そのval(words)の第一要素を変数名として代表させる、ということ。
(defun noise-word-p (word)
"Is this a low-content word that can be safely ignored?"
(member word '(a an the this number of $)))
;; word : 例の各要素 (If z is 3 |,| what is twice z)
;;; 7.2 Solving Algebraic Equations
(defun solve-equations (equations)
"Print the equations and their solution"
(print-equations "The equations to be solved are:" equations)
(print-equations "The solution is:" (solve equations nil)))
(defun solve (equations known)
"Solve a system of equations by constraint propagation."
;; Try to solve for one equation, and substitute its value into
;; the others. If that doesn't work, return what is known.
(or (some #'(lambda (equation)
(let ((x (one-unknown equation)))
(when x
(let ((answer (solve-arithmetic
(isolate equation x))))
(solve (subst (exp-rhs answer) (exp-lhs answer)
(remove equation equations))
(cons answer known))))))
equations)
known))
(defun isolate (e x)
"Isolate the lone x in e on the left-hand side of e."
;; This assumes there is exactly one x in e,
;; and that e is an equation.
(cond ((eq (exp-lhs e) x)
;; Case I: X = A -> X = n
e)
((in-exp x (exp-rhs e))
;; Case II: A = f(X) -> f(X) = A
(isolate (mkexp (exp-rhs e) '= (exp-lhs e)) x))
((in-exp x (exp-lhs (exp-lhs e)))
;; Case III: f(X)*A = B -> f(X) = B/A
(isolate (mkexp (exp-lhs (exp-lhs e)) '=
(mkexp (exp-rhs e)
(inverse-op (exp-op (exp-lhs e)))
(exp-rhs (exp-lhs e)))) x))
((commutative-p (exp-op (exp-lhs e)))
;; Case IV: A*f(X) = B -> f(X) = B/A
(isolate (mkexp (exp-rhs (exp-lhs e)) '=
(mkexp (exp-rhs e)
(inverse-op (exp-op (exp-lhs e)))
(exp-lhs (exp-lhs e)))) x))
(t ;; Case V: A/f(X) = B -> f(X) = A/B
(isolate (mkexp (exp-rhs (exp-lhs e)) '=
(mkexp (exp-lhs (exp-lhs e))
(exp-op (exp-lhs e))
(exp-rhs e))) x))))
;; このNorvigのコメントの書き方、わかりやすいな。
(defun print-equations (header equations)
"Print a list of equations."
(format t "~%~a~{~% ~{ ~a~}~}~%" header
(mapcar #'prefix->infix equations)))
(defconstant operators-and-inverses
'((+ -) (- +) (* /) (/ *) (= =)))
(defun inverse-op (op)
(second (assoc op operators-and-inverses)))
(defun unknown-p (exp)
(symbolp exp))
(defun in-exp (x exp)
"True if x appears anywhere in exp"
(or (eq x exp)
(and (exp-p exp)
(or (in-exp x (exp-lhs exp)) (in-exp x (exp-rhs exp))))))
(defun no-unknown (exp)
"Returns true if there are no unknowns in exp."
(cond ((unknown-p exp) nil) ;=1=
((atom exp) t) ;=2=
((no-unknown (exp-lhs exp)) (no-unknown (exp-rhs exp))) ;=3=
(t nil))) ;=4=
;; =1= : シンボルならnil。
;; =2= : シンボルじゃないatomならt。
;; =3= : ここにきたということはconsということ。で、左辺がno-unknownかcheck。
;; no-unknownなら右辺のno-unknown check結果を返却。
;; =4= : 左辺がno-unknownじゃないということ。なのでnil。
(defun one-unknown (exp)
"Returns the single unknown in exp, if there is exactly one."
(cond ((unknown-p exp) exp) ;=1=
((atom exp) nil) ;=2=
((no-unknown (exp-lhs exp)) (one-unknown (exp-rhs exp))) ;=3=
((no-unknown (exp-rhs exp)) (one-unknown (exp-lhs exp))) ;=4=
(t nil))) ;=5=
;; =1= : シンボルならそれを返せばよし。
;; =2= : シンボル以外のatomなら、no unknownなので、nil。
;; =3= : 左辺がno unknownなら、右辺がone unknownかどうかの結果を返す。
;; =4= : =3=の左右をいれかえた処理。
;; =5= : 左辺にも右辺にもunknownがあるので、nil。
(defun commutative-p (op)
"Is operator commutative?"
(member op '(+ * =)))
(defun solve-arithmetic (equation)
"Do the arithmetic for the right-hand side."
;; This assumes that the right-hand side is in the right form.
(mkexp (exp-lhs equation) '= (eval (exp-rhs equation))))
(defun binary-exp-p (x)
(and (exp-p x) (= (length (exp-args x)) 2)))
(defun prefix->infix (exp)
"Translate prefix to infix expressions."
(if (atom exp) exp ;=1=
(mapcar #'prefix->infix ;=2=
(if (binary-exp-p exp) ;=3=
(list (exp-lhs exp) (exp-op exp) (exp-rhs exp)) ;=4=
exp)))) ;=5=
;; 自分自身の中で、自分をmapcarで読んで再帰している。。。
;; =1= : atomならそのまま返して終了
;; =2= : atomじゃないならexp(式)はリストであって、
;; =3= : リストの要素たちに自分をmapcarするだけど、そのリストは加工したもので、
;; =4= : 要素がbinary-expならば、infixに変換したものがmapcar対象であり、
;; =5= : 要素がbinary-expでないならば(おそらくunary)、そのまま、というようなリスト。
;;ためしてみる。
;;CL-USER(22): (solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7))
;; (= (+ (* 3 x) y) 12)))
;;
;;The equations to be solved are:
;; (3 + 4) = ((5 - (2 + X)) * 7)
;; ((3 * X) + Y) = 12
;; 0[4]: (SOLVE ((= (+ 3 4) (* (- 5 (+ 2 X)) 7)) (= (+ (* 3 X) Y) 12)) NIL)
;; 1[4]: (ISOLATE (= (+ 3 4) (* (- 5 (+ 2 X)) 7)) X)
;; 2[4]: (ISOLATE (= (* (- 5 (+ 2 X)) 7) (+ 3 4)) X)
;; 3[4]: (ISOLATE (= (- 5 (+ 2 X)) (/ (+ 3 4) 7)) X)
;; 4[4]: (ISOLATE (= (+ 2 X) (- 5 (/ (+ 3 4) 7))) X)
;; 5[4]: (ISOLATE (= X (- (- 5 (/ (+ 3 4) 7)) 2)) X)
;; 5[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 4[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 3[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 2[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 1[4]: returned (= X (- (- 5 (/ (+ 3 4) 7)) 2))
;; 1[4]: (SOLVE ((= (+ (* 3 2) Y) 12)) ((= X 2)))
;; 2[4]: (ISOLATE (= (+ (* 3 2) Y) 12) Y)
;; 3[4]: (ISOLATE (= Y (- 12 (* 3 2))) Y)
;; 3[4]: returned (= Y (- 12 (* 3 2)))
;; 2[4]: returned (= Y (- 12 (* 3 2)))
;; 2[4]: (SOLVE NIL ((= Y 6) (= X 2)))
;; 2[4]: returned ((= Y 6) (= X 2))
;; 1[4]: returned ((= Y 6) (= X 2))
;; 0[4]: returned ((= Y 6) (= X 2))
;;
;;The solution is:
;; Y = 6
;; X = 2
;;NIL
;;CL-USER(23):
;;
;;
;;
;; studentが間違える例
;;
;;CL-USER(27): (student '(The daily cost of living for a group is the overhead cost plus
;; the running cost for each person times the number of people in
;; the group |.| This cost for one group equals $ 100 |,|
;; and the number of people in the group is 40 |.|
;; If the overhead cost is 10 times the running cost |,|
;; find the overhead and running cost for each person |.|))
;;
;;The equations to be solved are:
;; DAILY = (OVERHEAD + RUNNING)
;; COST = 100
;; PEOPLE = 40
;; OVERHEAD = 10
;; TO-FIND-1 = OVERHEAD
;; TO-FIND-2 = RUNNING
;; 0[4]: (SOLVE ((= DAILY (+ OVERHEAD RUNNING)) (= COST 100) (= PEOPLE 40) (= OVERHEAD 10) (= TO-FIND-1 OVERHEAD) (= TO-FIND-2 RUNNING)) NIL)
;; 1[4]: (ISOLATE (= COST 100) COST)
;; 1[4]: returned (= COST 100)
;; 1[4]: (SOLVE ((= DAILY (+ OVERHEAD RUNNING)) (= PEOPLE 40) (= OVERHEAD 10) (= TO-FIND-1 OVERHEAD) (= TO-FIND-2 RUNNING)) ((= COST 100)))
;; 2[4]: (ISOLATE (= PEOPLE 40) PEOPLE)
;; 2[4]: returned (= PEOPLE 40)
;; 2[4]: (SOLVE ((= DAILY (+ OVERHEAD RUNNING)) (= OVERHEAD 10) (= TO-FIND-1 OVERHEAD) (= TO-FIND-2 RUNNING)) ((= PEOPLE 40) (= COST 100)))
;; 3[4]: (ISOLATE (= OVERHEAD 10) OVERHEAD)
;; 3[4]: returned (= OVERHEAD 10)
;; 3[4]: (SOLVE ((= DAILY (+ 10 RUNNING)) (= TO-FIND-1 10) (= TO-FIND-2 RUNNING)) ((= OVERHEAD 10) (= PEOPLE 40) (= COST 100)))
;; 4[4]: (ISOLATE (= TO-FIND-1 10) TO-FIND-1)
;; 4[4]: returned (= TO-FIND-1 10)
;; 4[4]: (SOLVE ((= DAILY (+ 10 RUNNING)) (= TO-FIND-2 RUNNING)) ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100)))
;; 4[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 3[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 2[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 1[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;; 0[4]: returned ((= TO-FIND-1 10) (= OVERHEAD 10) (= PEOPLE 40) (= COST 100))
;;
;;The solution is:
;; TO-FIND-1 = 10
;; OVERHEAD = 10
;; PEOPLE = 40
;; COST = 100
;;NIL
;;CL-USER(28):
ただいま237Pまで到達。次回は第8章 Symbolic Mathematics: A Simplification Program。こつこつ。。。
0 件のコメント:
コメントを投稿