lisp实现自动递归---SICP不确定性计算
2012-11-26 11:01
369 查看
一、递归的需求
1. 树的遍历,我们首先需要判断当前节点是否为叶子结点,如果不是叶子结点,则需要在左右子树上递归的去遍历;2.迷宫的出口求解问题,当前位置是否为出口,如果不是,则需要在上下左右四个方法去递归搜索;
3.在微博看到一个爱因斯坦问题,如下:
1、在一条街上,有5座房子,喷了5种颜色。 2、每个房里住着不同国籍的人 3、每个人喝不同的饮料,抽不同品牌的香烟,养不同的宠物 问题是:谁养鱼? 提示: 1、英国人住红色房子 2、瑞典人养狗 3、丹麦人喝茶 4、绿色房子在白色房子左面 5、绿色房子主人喝咖啡 6、抽Pall Mall 香烟的人养鸟 7、黄色房子主人抽Dunhill 香烟 8、住在中间房子的人喝牛奶 9、 挪威人住第一间房 10、抽Blends香烟的人住在养猫的人隔壁 11、养马的人住抽Dunhill 香烟的人隔壁 12、抽Blue Master的人喝啤酒 13、德国人抽Prince香烟 14、挪威人住蓝色房子隔壁 15、抽Blends香烟的人有一个喝水的邻居
实际上这也是一个递归(搜索)问题,只不过看上去比较复杂而已。
二、自动递归的基础-延续
递归是如此的重要,如果我们有一种方法能够简化这类问题代码的编写,获得的收益将是巨大的。使用延续,可以让我们的代码实现自动递归,即我们只用编写代码延续的条件,递归是自动执行。
1、延续的概念
续延是在运行中被暂停了的程序:即含有计算状态的单个函数型对象。当这个对象被求值时,就会在它上次停下来的地方重新启动之前保存下来的计算。延续可以很方便的表示挂起的进程(类比linux中处于中断或者stop状态的进程),而在非确定计算中,延续表示搜索树中的节点。
续延可以理解成是一种广义的闭包。闭包就是一个函数加上一些指向闭包创建时可见的词法变量的指针。续延则是一个函数加上一个指向其创建时所在的整个栈的指针。
2、在drracket上实践延续(具体参考onlisp-20.1)
#lang racket (define frozen 0) (append '(the call/cc returned) (list (call-with-current-continuation (lambda (cc) (set! frozen cc) 'a)))) (define froz1 0) (define froz2 0) (let ((x 0)) (call-with-current-continuation (lambda (cc) (set! froz1 cc) (set! froz2 cc))) (set! x (+ 1 x)) x)CC表示当前的延续,是一个带有一个参数的函数,参数是什么,就返回什么,上面代码的意思就是将当前的延续保存在frozen,froz1,froz2种,然后下次就可以调用frozen/1/2, 执行当前的延续。
3、执行的结果如下
上面的代码执行结果会返回2次,这点确实比较奇怪。
4、树的遍历
(define (dft tree) (cond ((null? tree) '()) ((not (pair? tree)) (write tree)) (else (dft (car tree)) (dft (cdr tree))))) (define *saved* '()) (define (dft-node tree) (cond ((null? tree) (restart)) ((not (pair? tree)) tree) (else (call-with-current-continuation (lambda (cc) (set! *saved* (cons (lambda () (cc (dft-node (cdr tree)))) *saved*)) (dft-node (car tree))))))) (define (restart) (if (null? *saved*) 'done (let ((cont (car *saved*))) (set! *saved* (cdr *saved*)) (cont)))) (define t1 '(a (b (d h)) (c e (f i) g))) (define (dft2 tree) (set! *saved* '()) (let ((node (dft-node tree))) (cond ((eq? node 'done) '()) (else (write node) (restart)))))执行结果如下:
注意,dft2居然延续的是(let((node (dft2 t1))), 这点确实非常不可思议,CC保存的是整个执行栈的环境。
三、common-lisp实现延续
(defvar *actual-cont* #'values) (define-symbol-macro *cont* *actual-cont*) (defmacro =lambda (parms &body body) `#'(lambda (*cont* ,@parms) ,@body)) (defmacro =defun (name parms &body body) (let ((f (intern (concatenate 'string "=" (symbol-name name))))) `(progn (defmacro ,name ,parms `(,',f *cont* ,,@parms)) (defun ,f (*cont* ,@parms) ,@body)))) (defmacro =bind (parms expr &body body) `(let ((*cont* #'(lambda ,parms ,@body))) ,expr)) (defmacro =values (&rest retvals) `(funcall *cont* ,@retvals)) (defmacro =funcall (fn &rest args) `(funcall ,fn *cont* ,@args)) (defmacro =apply (fn &rest args) `(apply ,fn *cont* ,@args)) (defparameter *paths* nil) (defconstant failsym '@) (defmacro choose (&rest choices) (if choices `(progn ,@(mapcar #'(lambda (c) `(push #'(lambda () ,c) *paths*)) (reverse (cdr choices))) ,(car choices)) '(fail))) (defmacro choose-bind (var choices &body body) `(cb #'(lambda (,var) ,@body) ,choices)) (defun cb (fn choices) (if choices (progn (if (cdr choices) (push #'(lambda () (cb fn (cdr choices))) *paths*)) (funcall fn (car choices))) (fail))) (defun fail () (if *paths* (funcall (pop *paths*)) failsym))
解释
(=defun add1 (x) (=values (1+ x)))
将会被展开为
(progn (defmacro add1 (x)
‘(=add1 *cont* ,x))
(defun =add1 (*cont* x)
(=values (1+ x))))
*cont*的含义是绑定到当前的延续,=value显示了当前延续的作用,将结果作为参数,直接调用当前的延续。参 数 *cont* 告 诉 那 个 由 =defun 定 义 的 函 数 对 其 返 回 值 做 什 么。
> (=defun message ()
(=values ’hello ’there))
MESSAGE
(=defun baz ()
(=bind (m n) (message)
(=values (list m n))))
BAZ
> (baz)
(HELLO THERE)
注意到 =bind 的展开式会创建一个称为 *cont* 的新变量。baz 的主体展开成:
(let ((*cont* #’(lambda (m n)
(=values (list m n)))))
(message))
然后会变成:
(let ((*cont* #’(lambda (m n)
(funcall *cont* (list m n)))))
(=message *cont*))
由于 *cont* 的新值是 =bind 表达式的代码体,所以当 message 通过函数调用 *cont* 来 “返回” 时,结果将是去求值这个代码体
4000
。尽管如此 (并且这里是关键), =bind 的主体里:
在
#’(lambda (m n)
(funcall *cont* (list m n)))
作为参数传递给 =baz 的 *cont* 仍然是可见的,所以当代码的主体求值到一个 =values 时,它将能够返回到最初的主调函数那里。所有闭包环环相扣:每个 *cont* 的绑定都包含了上一个 *cont* 绑定的闭包,它们串成一条锁链,锁链的尽头指向那个全局的值。
基于延续的自动递归
问题实践一
baker cooper fletcher miller smith分别住在一个五层公寓楼的不同层,baker不在顶层,cooper不在底层,fletcher不在顶层和底层,miller住在cooper的上面(不一定是相邻的层),smith和fletcher不在相邻的层,求他们各住在那一层。;baker cooper fletcher miller smith (=defun people-dwelling () (choose-bind baker '(1 2 3 4 5) (choose-bind cooper '(1 2 3 4 5) (choose-bind fletcher '(1 2 3 4 5) (choose-bind miller '(1 2 3 4 5) (choose-bind smith '(1 2 3 4 5) (=values baker cooper fletcher miller smith))))))) (defun distinct? (items) (cond ((null items) t) ((member (car items) (cdr items)) nil) (t (distinct? (cdr items))))) (=defun calculate () (=bind (baker cooper fletcher miller smith) (people-dwelling) (if (and (distinct? (list baker cooper fletcher miller smith)) (not (= baker 5)) (not (= cooper 1)) (not (= fletcher 5)) (not (= fletcher 1)) (> miller cooper) (not (= (abs (- smith fletcher)) 1)) (not (= (abs (- fletcher cooper)) 1))) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)) (fail))))
结果如下:
爱因斯坦问题实践
(defmacro var-choose-choices (choices (&rest choosers) &rest body) (if (null choosers) `(progn ,@body) `(choose-bind ,(car choosers) ,choices (var-choose-choices ,choices ,(cdr choosers) ,@body))))
(=defun people-character () (var-choose-choices '(1 2 3 4 5) (ep sp dp np gp) (=values ep sp dp np gp)))
(=defun Einstein () (=bind (eno sno dno nno gno) (people-character) (let ((houses (list eno sno dno nno gno))) (if (and (distinct? houses) (= nno 1)) (=bind (ecolor scolor dcolor ncolor gcolor) (people-character) (let ((colors (list ecolor scolor dcolor ncolor gcolor))) (if (and (distinct? colors) (< (get-another-property 3 colors houses) (get-another-property 2 colors houses)) (= (abs (- nno (get-another-property 5 colors houses))) 1) (= ecolor 1)) (=bind (edrink sdrink ddrink ndrink gdrink) (people-character) (let ((drinks (list edrink sdrink ddrink ndrink gdrink))) (if (and (distinct? drinks) (= ddrink 1) (= (get-another-property 3 colors drinks) 2) (= (get-another-property 3 houses drinks) 3)) (=bind (esmoke ssomke dsmoke nsmoke gsmoke) (people-character) (let ((smokes (list esmoke ssomke dsmoke nsmoke gsmoke))) (if (and (distinct? smokes) (= (get-another-property 4 smokes drinks) 4) (= gsmoke 5) (= 1 (abs (- (get-another-property 3 smokes houses) (get-another-property 5 drinks houses)))) (= (get-another-property 4 colors smokes) 2)) (=bind (epat spat dpat npat gpat) (people-character) (let ((pats (list epat spat dpat npat gpat))) (if (and (distinct? pats) (= ecolor 1) (= spat 1) (= ddrink 1) (< (get-another-property 3 colors houses) (get-another-property 2 colors houses)) (= (get-another-property 3 colors drinks) 2) (= (get-another-property 1 smokes pats) 2) (= (get-another-property 4 colors smokes) 2) (= (get-another-property 3 houses drinks) 3) (= nno 1) (= 1 (abs (- (get-another-property 3 smokes houses) (get-another-property 3 pats houses)))) (= 1 (abs (- (get-another-property 4 pats houses) (get-another-property 2 smokes houses)))) (= (get-another-property 4 smokes drinks) 4) (= gsmoke 5) (= (abs (- nno (get-another-property 5 colors houses))) 1) (= 1 (abs (- (get-another-property 3 smokes houses) (get-another-property 5 drinks houses))))) (list houses colors drinks smokes pats) (fail)))) (fail)))) (fail)))) (fail)))) (fail)))) (fail))上面代码中e,s,d,n,g开头的单词分别代表英国人,瑞典人,丹麦人,挪威人,德国人
其中1、2、3、4、5分别代表
;1 2 3 4 5 represent
;house no 1 2 3 4 5
;red white green yellow blue
;tea coffee milk beer water
;pallmall dunhill blends bluemaster prince
;dog bird cat horse fish
代码的中间部分有些重复,把所有的条件列举了一遍,这个主要是避免条件的遗漏。
执行的结果是
养鱼的人是德国人
相关文章推荐
- 杨辉三角问题-计算第m层的第n个系数 (递归实现)
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载]
- 递归下降法实现计算表达式
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载]
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载]
- Tensorflow学习笔记(三)实现降噪自动编码器--美化计算图
- js GridView 实现自动计算操作代码
- JQuery实现的购物车功能(可以减少或者添加商品并自动计算价格)
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载][续]
- 实现表格自动计算
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载]
- 【Java】斐波那契数列(Fibonacci Sequence、兔子数列)的3种计算方法(递归实现、递归值缓存实现、循环实现、尾递归实现)
- IOS7环境实现自动计算TableViewCell高度的方法
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载]
- js操作GridView,实现自动计算
- Masonry实现不同行高的自定义cell布局”行高自动计算"
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载]
- 利用jQuery实现购物车自动计算总金额
- C#代码行数的计算工具(递归的实现)
- Asp.net 2.0 自定义控件开发[实现自动计算功能(AutoComputeControl)][示例代码下载续][重点推荐控件]