迷宫问题的非确定性解法

bankrock · #1 (**permalink**) 2008-03-10

本来想发到首页上，可是发现我居然可耻的忘了怎么发文

迷宫问题的非确定性解法

非确定性计算这个术语引用自SICP，是指一个表达式可以有多个值，evaluator在含有多个可能值的表达式处依次取值，分支执行后面的程序。如果一个表达式的值无法得出结果，则自动返回上一个分支表达式，执行下一个分支程序。本文提供了在SICP4.3节介绍的非确定性计算Evaluator的基础上解决迷宫问题的算法。

1. 迷宫问题的搜索算法
使用的迷宫例子如下(4*4的方形迷宫)（这个例子是从SICP的教学录像里看到的）：

图：迷宫示例（其中*号代表起始点，终点为有开口的格子，也就是坐标(1, 0)。
解决迷宫问题可用原始的搜索算法（标记—尝试方法），即记录当前已经走过的迷宫格子，然后在当前位置尝试每一个可行的方向（可行方向的目的地不能和已走过的格子重叠），并继续标记走过的路径，如果某个方向无法再进行下去则退回到上一个位置继续尝试其他的可行方向，直到到达目的地。其自然算法如下：
(1)如果当前位置为终点，则迷宫算法完成，返回可行路径。
(2)选择可行方向（这里一共有上下左右四种方向）
(3)根据可行方向计算下一个到达的格子
(4)计算下一个格子是否在迷宫坐标范围内，而且以前没有走过，并且有门联通当前格子。符合上述条件则该方向可行，否则退回到第(2)步。
(5)将这个格子标记为已走过，并加入可行迷宫路径中。

继续第(1)步

2. 算法的非确定性语言实现
可以看出选择可行方向并尝试的算法，需要实现它的语言能自动尝试某个方向，在进入死胡同后自动返回到上一个可行点，消除从上一个可行点开始记录过的路径（就像为不留下踪迹，用树枝扫清走过的足迹一样），并从上一个可行点搜索其他的路径。使用SICP4.3节提供的非确定性语言(Amb)可以轻松解决。Amb语言实现的迷宫算法如下：
(1)使用List记录当前迷宫被走过的格子（初时状态只有起始点被走过）：

代码:

(define current-grids
  (list (list (list 0 0) false) 
	(list (list 0 1) false) 
	(list (list 0 2) false)
	(list (list 0 3) false)
	(list (list 1 0) false) 
	(list (list 1 1) false) 
	(list (list 1 2) false)
	(list (list 1 3) false)
	(list (list 2 0) false) 
	(list (list 2 1) false) 
	(list (list 2 2) false)
	(list (list 2 3) false)
	(list (list 3 0) false) 
	(list (list 3 1) false) 
	(list (list 3 2) false)
	(list (list 3 3) false)))

(2)使用List记录各个格子间的联通状况（这里记录门的”坐标”表示联通状况）

代码:

(define gates
  (list (list (/ 1 2) 0)
	(list (/ 5 2) 0)
	(list 0 (/ 1 2))
	(list 2 (/ 1 2))
	(list 3 (/ 1 2))
	(list (/ 3 2) 1)
	(list 0 (/ 3 2))
	(list 1 (/ 3 2))
	(list 2 (/ 3 2))
	(list 3 (/ 3 2))
	(list (/ 5 2) 2)
	(list 0 (/ 5 2))
	(list 1 (/ 5 2))
	(list 2 (/ 5 2))
	(list (/ 1 2) 3)
	(list (/ 3 2) 3)))

(3)非确定性迷宫路径搜索算法

代码:

(define (run-maze current-coord)
  (if (coord-eq? current-coord destination)
      'ok
      (let ((direc (an-element-of directions)))
	(let ((ncoord (next-coord current-coord direc)))
	  (require (and (grid-available? ncoord)
			(connected? current-coord ncoord)))

	  (set-grid-unavail! ncoord)
	  (append-path ncoord)
(run-maze ncoord)))))

这里(direc (an-element-of directions))语句选择任意一个方向，然后使用(require (and (grid-available? ncoord) (connected? current-coord ncoord)))语句确定这个方向是否可行，可行的话使用 (set-grid-unavail! ncoord) 将下一个格子标记为已走过，并使用(append-path ncoord)将下一个格子添加到可行路径中，然后从下一个格子开始递归搜索。
完整的程序如下：

代码:

(define (and a b)
  (if (not a)
      false
      (if (not b)
	  false
	  b)))


;;;;;;;;;;;;;;;;;;;;;;;;;Maze Data;;;;;;;;;;;;;;;
(define current-grids
  (list (list (list 0 0) false) 
	(list (list 0 1) false) 
	(list (list 0 2) false)
	(list (list 0 3) false)
	(list (list 1 0) false) 
	(list (list 1 1) false) 
	(list (list 1 2) false)
	(list (list 1 3) false)
	(list (list 2 0) false) 
	(list (list 2 1) false) 
	(list (list 2 2) false)
	(list (list 2 3) false)
	(list (list 3 0) false) 
	(list (list 3 1) false) 
	(list (list 3 2) false)
	(list (list 3 3) false)))

(define gates
  (list (list (/ 1 2) 0)
	(list (/ 5 2) 0)
	(list 0 (/ 1 2))
	(list 2 (/ 1 2))
	(list 3 (/ 1 2))
	(list (/ 3 2) 1)
	(list 0 (/ 3 2))
	(list 1 (/ 3 2))
	(list 2 (/ 3 2))
	(list 3 (/ 3 2))
	(list (/ 5 2) 2)
	(list 0 (/ 5 2))
	(list 1 (/ 5 2))
	(list 2 (/ 5 2))
	(list (/ 1 2) 3)
	(list (/ 3 2) 3)))

(define current-path '())

(define directions (list (list 1 0) (list -1 0) (list 0 1) (list 0 -1)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (require x)
  (if (not x) (amb)))

(define (an-element-of elems)
  (require (not (null? elems)))
  (amb (car elems) (an-element-of (cdr elems))))

(define (next-coord x direc)
  (list (+ (car x) (car direc)) (+ (cadr x) (cadr direc))))

(define (gate-coord x y)
  (list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2)))

(define (coord-eq? x y)
  (and (= (car x) (car y)) (= (cadr x) (cadr y))))

(define (grid-available? coord)
  (let ((grid-info (assoc coord current-grids)))
    (if grid-info
	(not (cadr grid-info))
	)))

(define (connected? x y)
  (member (gate-coord x y) gates))

(define (set-grid-unavail! coord)
  (let ((grid-info (assoc coord current-grids)))
    (set-car! (cdr grid-info) true)))
    

(define (append-path coord)
 (set! current-path (cons coord current-path)))	

(define (run-maze current-coord)
  (if (coord-eq? current-coord destination)
      'ok
      (let ((direc (an-element-of directions)))
	(let ((ncoord (next-coord current-coord direc)))
	  (require (and (grid-available? ncoord)
			(connected? current-coord ncoord)))

	  (set-grid-unavail! ncoord)
	  (append-path ncoord)
	  (run-maze ncoord)))))

;;;;;;;;;;;;;;;;;;;;Run;;;;;;;;;;;;;;;
(define start-position (list 2 3))
(define destination (list 1 0))

(set-grid-unavail! start-position)
(append-path start-position)

(define (main)
  (run-maze start-position)
  (display current-path))

(main)

3. 为实现迷宫算法对Amb Evaluator的改进
注意上述程序在记录已走过的迷宫格子时使用到了List的变动过程set-car!

代码:

(define (set-grid-unavail! coord)
  (let ((grid-info (assoc coord current-grids)))
    (set-car! (cdr grid-info) true)))

因为在非确定性算法中，进入死胡同后需要退回到上一个分支点，这个过程中必须消除所有的更改操作的影响，这样不得已需要将set-car!作为Evaluator的关键字作特殊处理，因此需要在Amb Evaluator的Analyzer中添加处理set-car!的条目（为了节省篇幅就不列出完整的Aanalyzer实现了，具体请参考SICP的第四章）：

代码:

;;;;;;;;;;;;;analyzer;;;;;;;;;;;;;;;;;
(define (analyze exp)
  (cond ((amb? exp) (analyze-amb exp))
	((self-evaluating? exp) …….)
	((quoted? exp) (analyze-quoted exp))
	……….
	((set-car!? exp) (analyze-set-car! exp))
	……..
((cond? exp) (analyze (cond->if exp)))
	((let? exp) (analyze (let->application exp)))
	((application? exp) (analyze-application exp))
	(else
	 (error "Unknown expression type -- ANALYZE" exp))))

Set-car!的具体分析实现如下：

代码:

;;;;;;;;;;;;;;;;set-car!;;;;;;;;;;;;;;;;;;
(define (set-car!? exp)
  (tagged-list? exp 'set-car!))

(define (set-car!-list exp)
  (cadr exp))
(define (set-car!-value exp)
  (caddr exp))

(define (analyze-set-car! exp)
  (let ((lproc (analyze (set-car!-list exp)))
	(vproc (analyze (set-car!-value exp))))
    (lambda (env succeed fail)
      (lproc env
	     (lambda (list-val fail2)
	       (vproc env
		      (lambda (val fail3)
			(let ((old-value
			       (car list-val)))
			  (set-car! list-val val)
			  (succeed 'ok
				   (lambda ()
				     (set-car! list-val old-value)
				     (fail3)))))
		      fail2))
	     fail))))

这里analyze-set-car!过程将记录下set-car!改变的List，以及改变之前的List的car值，并截获之前的失败处理过程，如果程序执行失败，则首先将List原来的car值重置回去，然后调用截获的失败处理过程。
这种实现方法的一大弱点是没有利用到Amb语言的环境，直接调用了Scheme过程处理List（由于Amb Evaluator本身就没有实现List结构，因此这里使用了比较取巧的办法）。由于没有List的背景信息，如果程序在其后的执行过程中已经将这个List抛弃了，那么重置car值也就毫无意义（这里set-car!操纵的List是全局变量current-grid，因此不会发生List被抛弃的事情）。

4. 运行示例
使用第1节中的示例，第一次运行得到如下的结果：

引用:

:::Amb-Eval value:
ok
((1 0) (0 0) (0 1) (0 2) (0 3) (1 3) (2 3))

输入try-again得到另一条可行的路径：

引用:

:::Amb-Eval value:
ok
((1 0) (0 0) (0 1) (0 2) (0 3) (1 3) (1 2) (1 1) (2 1) (2 0) (3 0) (3 1) (3 2) (2 2) (2 3))

再次输入try-again得到第三条可行路径：

引用:

:::Amb-Eval value:
ok
((1 0) (0 0) (0 1) (0 2) (0 3) (1 3) (1 2) (1 1) (2 1) (2 2) (2 3))

最后输入try-again提示已没有路径可选：

引用:

:::There are no more values of
(main)

5. 其他
这里对SICP的Amb Evaluator的输入控制作了些改变，不是直接从REPL中读取，而是从文件中读取，这样可以比较方便的读取大段程序。另外Scheme确实是个了不起的语言，用Scheme写程序可以将注意力全集中在程序的意义上，给人的感觉非常纯粹惬意。而且Scheme这种用简洁的语法表达出复杂范式的能力，真让我为C++汗颜。

附件：附上根据SICP实现的完整Amb Evaluator以及Maze程序，在MIT Scheme 7.7.90+上运行通过

cat · #2 (**permalink**) 2008-03-11

还是这种语言好玩。不过迷宫非确定没法带来什么效率上的提升地说……

bankrock · #3 (**permalink**) 2008-03-11

要效率的话直接Breadth-first Search了。
非确定性算法的美妙之处在于"What is it?"可以反映出"How is it done?"，效率是次要的。话说SICP上介绍的很多算法效率奇低（递归用得太多了），但是看起来那个赏心悦目啊

cat · #4 (**permalink**) 2008-03-11

的确华丽啊~
最理想就是像SQL一样，写得华丽，优化靠一些execution plan generation和少量的performance HINT, 最终效率也很好。

Elminster · #5 (**permalink**) 2008-03-11

搞 functional / logical programming 那帮人就是整天憋着想把写程序搞得和写公式一样，最高理想就是用式子把问题描述清楚了，对应的程序也就有了，这就是 descriptive 的由来。

哼哼，在人类拥有无限计算能力之前，这帮人永远只能 YY 。

liuxinyu · #6 (**permalink**) 2008-03-11

对了，分享一下，昨天刚刚看到一个一石二鸟的好东东：
Write Yourself a Scheme in 48 hours

48小时利用haskell写一个scheme的解释器。

最近看了看huskell，很有趣。但是觉得还是scheme简单纯粹。这大概就是语法糖衣和简单统一不能鱼和熊掌兼得吧。sicp是本好书，值得反复看。