270 likes | 465 Views
Functional Programming. 09 Examples. Tower of Hanoi. C. A. B. Tower of Hanoi. Tower of Hanoi. 希望執行結果 > (tower-of- hanoi ‘(3 2 1) ‘a ‘b ‘c) ; 三個盤子 柱子 a b c 7 第一步 寫外殼 ( defun tower-of- hanoi (disks from to spare) ) 第二步 決定遞迴 何時停止? 盤子搬完 還有盤子就搬並計算次數 (繼續遞迴)
E N D
Functional Programming 09 Examples
Tower of Hanoi C A B
Tower of Hanoi • 希望執行結果 • > (tower-of-hanoi ‘(3 2 1) ‘a ‘b ‘c) ;三個盤子 柱子a b c7 • 第一步 寫外殼 • (defun tower-of-hanoi (disks from to spare) ) • 第二步 決定遞迴 • 何時停止? 盤子搬完 • 還有盤子就搬並計算次數 (繼續遞迴) • (if (endp disks) xxx ;沒有盤子就return 0 (需要零次)ooo ;有盤子就繼續搬並計算次數)
Tower of Hanoi • 第三步 決定次數計算方式 • xxx? • 0 (沒盤子就不必搬了,所以直接return 0) • ooo? • 先把上面n-1個搬到暫存區spare要幾次?(tower-of-hanoi (rest disks ) from spare to) • 再把最底下那個搬到目的地to要幾次?1 • 再把暫存區的n-1個搬到目的地to要幾次? (tower-of-hanoi (rest disks ) spare to from)
Tower of Hanoi (defun tower-of-hanoi (disks from to spare) (if (endp disks) 0 (+ (tower-of-hanoi (rest disks) from spare to) 1 (tower-of-hanoi (rest disks) spare to from) ) ) )
Tower of Hanoi • 希望執行結果 要包含搬法 • > (tower-of-hanoi ‘(3 2 1) ‘a ‘b ‘c) ;三個環 柱子a b cMove 1 from A to B.Move 2 from A to C.Move 1 from B to C.Move 3 from A to B.Move 1 from C to A.Move 2 from C to B.Move 1 from A to B.NIL
Tower of Hanoi • 僅須修改剛剛的ooo • 先把上面n-1個搬到暫存區spare要幾次?(tower-of-hanoi (rest disks ) from spare to) • 再把最底下那個搬到目的地to要幾次?1 • 再把暫存區的n-1個搬到目的地to要幾次? (tower-of-hanoi (rest disks ) spare to from) ->把1改成 (format t “Move ~A from ~A to ~A.~%” (car disks) from to) 把+去掉改成(progn ) 但是如果盤子空了要作什麼? 沒要作什麼..所以把if 改成unless..那麼prog可以去掉
Tower of Hanoi (defun tower-of-hanoi (disks from to spare) (unless (endp disks) (tower-of-hanoi (rest disks) from spare to) (format t "Move ~A from ~A to ~A.~%" (car disks) from to) (tower-of-hanoi (rest disks) spare to from) ) )
Inference - Matching • > (match ‘(p a b c a) ‘(p ?x ?y c ?x))((?Y . B) (?X . A))T • > (match ‘(p ?x b ?y a) ‘(p ?y b c a))((?Y . C) (?X . ?Y))T • > (match ‘(a b c) ‘(a aa))NIL • > (match ‘(p ?x) ‘(p ?x))NILT • > (match ‘(p ?v b ?x d (?z ?z)) ‘(p a ?w c ?y (e e)) ‘((?v . a) (?w . b)))((?Z . E) (?Y . D) (?X . C) (?V . A) (?W . B))T • > (match ‘(?x a) ‘(?y ?y))((?Y . A) (?X . ?Y))T
Inference - Matching • 第一步 想match的步驟 • If x and y are eql, then match; otherwise, • If x is a variable that has a binding, they match if it matches y; otherwise, • If y is a variable that has a binding, they match if it matches x; otherwise, • If x is a variable(without a binding), they match and thereby establish a binding for it; otherwise, • If y is a variable(without a binding), they match and thereby establish a binding for it; otherwise, • They match if they are both conses, and the cars match, and the cdrs match with the bindings generated thereby.
Inference - Matching • 第二步 寫一個可判斷是否為變數的函數 • 是否為symbol(symbolp x) • Symbol的字串中第一個字元是否為’?’(eql(char (symbol-name x) 0) #\?) • (defunvar? (x) (and (symbolp x) (eql (char (symbol-name x) 0) #\?)))
Inference - Matching • 回顧 assoc • > (setq x (cons ‘a ‘b))(A . B) • > (setq y (cons ‘c ‘d))(C . D) • > (setq q (list x y))((A . B) (C . D)) • > (assoc ‘a q)(A . B)
Inference - Matching • If x and y are eql, then match; ((eql x y) (values binds t)) • If x is a variable that has a binding, they match if it matches y; ((assoc x binds) (match (binding x binds) y binds)) • If y is a variable that has a binding, they match if it matches x; ((assoc y binds) (match x (binding y binds) binds)) • If x is a variable(without a binding), they match and thereby establish a binding for it; ((var? x) (values (cons (cons x y) binds) t));把新的bind(關於x)加入binds • If y is a variable(without a binding), they match and thereby establish a binding for it; ((var? y) (values (cons (cons y x) binds) t)) ;把新的bind (關於y)加入binds
Inference - Matching • They match if they are both conses, and the cars match, and the cdrs match with the bindings generated thereby. (when (and (consp x) (consp y)) ;x與y都是cons (multiple-value-bind (b2 yes) ;把b2與yesbind 到 (match (car x) (car y) binds);(car x)與(car y)的match (and yes (match (cdr x) (cdr y) b2)))) ;若(car x) 與(car y)已經match,也就是yes為T,則再接 ;著match (cdr x) (cdr y),且已經將binding更新為b2
Inference - Matching (defun match (x y &optional binds) (cond ((eql x y) (values binds t)) ((assoc x binds) (match (binding x binds) y binds)) ((assoc y binds) (match x (binding y binds) binds)) ((var? x) (values (cons (cons x y) binds) t)) ((var? y) (values (cons (cons y x) binds) t)) (t (when (and (consp x) (consp y)) (multiple-value-bind (b2 yes) (match (car x) (car y) binds) (and yes (match (cdr x) (cdr y) b2)))))))
Inference - Matching • 第三步 找某個變數的binding方式(defun binding (x binds) (let ((b (assoc x binds)));找binds裡頭有x的,例如 (x, □) (if b;如果有找到,知道被bind到(cdr b) (or (binding (cdr b) binds);繼續找看看(cdr b)bind 到誰,例如(□, ◎) (cdr b)))));往下沒有可繼續bind的話,則 就是(cdr b),例如 □
Inference - Answering Queries • 第四步 回答誰誰誰符合某種關係 • > (parent ?x ?y)(((?x . donald) (?y . nancy)) • 呼叫<-以加入rule或fact並且return目前關於某個predicate的rule有幾個 • > (<- (parent donaldnancy))1 • > (<- (child ?x ?y) (parent ?y ?x))1
Inference - Answering Queries • (defvar *rules* (make-hash-table)) ;定義一個全域變數為hash table • (defmacro <- (con &optional ant) ;定義一個巨集<- `(length (push (cons (cdr ',con) ',ant) (gethash (car ',con) *rules*)))) • If you prefix a comma to something within a ` (backquoated) expression, it will be evaluated • > `(a b c)(A B C) • > (setf a 1 b 2)2 • > `(a is ,a and b is ,b)(A IS 1 AND B IS 2)
Inference - Answering Queries (defun prove (expr &optional binds);expr可能是(parent ?x ?y)或 (and ( ) ( ) ( )) (case (car expr) ;看是否為rule(有and or not) (and (prove-and (cdrexpr) binds)) (or (prove-or (cdrexpr) binds)) (not (prove-not (cadrexpr) binds)) (t (prove-simple (car expr) (cdrexpr) binds)))) ;不是rule,例如(parent ?x ?y) (defun prove-simple (predargsbinds) ; parent(?x ?y) binds (mapcan#'(lambda (r) (multiple-value-bind (b2 yes) ;分別把match的binding結果以及 (match args (car r);成功與否給b2與yes binds) (when yes;如果有成功binding (if (cdr r) ;如果是rule,即 r是像 (and (male ?x) ( ) ) (prove (cdr r) b2) ;要以b2為新的binds,繼續prove (list b2))))) ;return (b2) (mapcar #‘change-vars;把以pred為key的那些rule找出來, (gethashpred *rules*)))) ;並且把其中的變數換成新產生的
Inference - Answering Queries • > (prove-simple 'parent ' (donaldnancy) nil)(NIL) ;沒有binding可以prove所問的 • > (prove-simple 'child '(?x ?y) nil)(((#:?6 . NANCY) (#:?5 . DONALD) (?Y . #:?5) (?X . #:?6))) ;有binding可以促成所詢問的關係
Inference - Answering Queries (defun change-vars (r) (sublis (mapcar #'(lambda (v) (cons v (gensym "?"))) (vars-in r)) r)) ;把r中的變數都換成新產生的?xxxx (defunvars-in (expr) ;找expr中所有的變數 (if (atom expr) (if (var? expr) (list expr)) (union (vars-in (car expr)) (vars-in (cdrexpr)))))
Inference - Answering Queries (defun prove-and (clauses binds) (if (null clauses) ;若遞迴到clauses為null (list binds) ;直接return目前的binds (mapcan #‘ (lambda (b) (prove (car clauses) b));第一個clause作prove (prove-and (cdr clauses) binds)))) ;後面剩下的clause作prove-and (defun prove-or (clauses binds) (mapcan #‘(lambda (c) (prove c binds)) ;對每一個clause都 clauses));繼續做prove (defun prove-not (clause binds) ;clause只有一句 (unless (prove clause binds);繼續prove,找新的binds (list binds))) ;prove不出來就用舊的binds
Inference - Answering Queries (defmacro with-answer (query &body body) (let ((binds (gensym))) ;產生一個新變數,假設是g1 ‘(dolist (,binds (prove ’,query)) ;將prove完的binding結果 (let ,(mapcar #’(lambda (v) ;依序給g1 ‘(,v (binding ',v ,binds))) (vars-in query)) ,@body)))) ;query: 想問的問題,如 (parent ?x ?y) ;body : 找出binding後想把它怎麼處理 ;,@會把body evaluate出來並且把所有elements拆解出來 • >(prove '(parent ?x ?y)) (((?Y . DEBBIE) (?X . DONALD)) ((?Y . NANCY) (?X . DONALD)))
Inference - Answering Queries (with-answer (p ?x ?y) (f ?x ?y)) is macroexpanded into: (dolist (#:g1 (prove ‘(p ?x ?y))) (let ((?x (binding ‘?x #:g1)) (?y (binding ‘?y #:g1))) (f ?x ?y))) • > (with-answer (parent ?x ?y) (format t “~A is the parent of ~A. ~%” ?x ?y))DONALD is the parent of NANCY.NIL
Inference - Analysis • If we do a (clrhash *rules*) and then define the following rules andfacts,定義一堆事實與規則到hash table *rule*中 (<- (parent donaldnancy)) (<- (parent donalddebbie)) (<- (male donald)) (<- (father ?x ?y) (and (parent ?x ?y) (male ?x))) (<- (= ?x ?x)) (<- (sibling ?x ?y) (and (parent ?z ?x) (parent ?z ?y) (not (= ?x ?y))))
Inference - Analysis 我們最後想做到: • we will be able to make inferences like the following: • > (with-answer (father ?x ?y) (format t "~A is the father of ~A. ~%” ?x ?y)) DONALD is the father of DEBBIE. DONALD is the father of NANCY. NIL • > (with-answer (sibling ?x ?y) (format t "~A is the sibling of ~A. ~%” ?x ?y)) DEBBIE is the sibling of NANCY. NANCY is the sibling of DEBBIE. NIL