1 / 27

Functional Programming

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) ) 第二步 決定遞迴 何時停止? 盤子搬完 還有盤子就搬並計算次數 (繼續遞迴)

Download Presentation

Functional Programming

An Image/Link below is provided (as is) to download presentation Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript


  1. Functional Programming 09 Examples

  2. Tower of Hanoi C A B

  3. Tower of Hanoi

  4. 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 ;有盤子就繼續搬並計算次數)

  5. 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)

  6. 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) ) ) )

  7. 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

  8. 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可以去掉

  9. 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) ) )

  10. 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

  11. 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.

  12. Inference - Matching • 第二步 寫一個可判斷是否為變數的函數 • 是否為symbol(symbolp x) • Symbol的字串中第一個字元是否為’?’(eql(char (symbol-name x) 0) #\?) • (defunvar? (x) (and (symbolp x) (eql (char (symbol-name x) 0) #\?)))

  13. 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)

  14. 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

  15. 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

  16. 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)))))))

  17. 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),例如 □

  18. 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

  19. 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)

  20. 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*)))) ;並且把其中的變數換成新產生的

  21. 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可以促成所詢問的關係

  22. 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)))))

  23. 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

  24. 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)))

  25. 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

  26. 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))))

  27. 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

More Related