第十四章 不確定性
====================
麥卡錫的非確定運算符`amb`幾乎和Lisp一樣古老，盡管現在它已經從Lisp中消失了。`amb`接受一個或多個表達式，并在它們中進行一次“非確定”（或者叫“模糊”）選擇，這個選擇會讓程序趨向于有意義。現在我們來探索一下Scheme內置的`amb`過程，該過程會對模糊的選項進行深度優先選擇，并使用Scheme的控制操作符`call/cc`來回溯其他的選項。結果是一個優雅的回溯機制，該機制可用于在Scheme中對問題空間進行搜索而不需要另一種擴展了的語言。這種內嵌的恢復續延的機制可以用來實現Prolog風格的邏輯語言，但是更方便（sparer），因為這個操作符更像是Scheme的一個布爾運算符，使用時不需要特殊的上下文（context），而且也不依賴語言學的一些基礎元素如邏輯變量和歸納法（unification）。
## 14.1 對amb的描述
最早的Scheme的教程SICP對`amb`進行了易于理解的描述，同時還給出了許多例子。說得直白一些，`amb`接受零個或更多表達式并“不確定”的返回其中“一個”的值。因此：
```scheme
(amb 1 2)
```
的結果可能為1或2。
不帶參數調用`amb`則不會有返回值，而且應該會出錯。因此：
```scheme
(amb)
-->ERROR!!! amb tree exhausted
```
（我們后面再討論這個錯誤信息。）
特別的，如果它的至少一個外層表達式收斂（converges）此時需要`amb`返回一個值，那么就不會出錯，因此：
```scheme
(amb 1 (amb))
```
而且：
都返回`1`。
很明顯，`amb`不能簡單的等同于它的第一個子表達式，因為它必須返回一個“非錯誤”的值，如果有這種可能的話。然而，僅僅這樣還不夠：為使程序收斂的選擇比單純選擇`amb`的子表達式要更加嚴格。`amb`應該返回讓“整個”程序收斂的值。在這個意義上，`amb`是一個“神”一般的運算符。
比如：
```scheme
(amb #f #t)
```
可以返回`#f`或`#t`，但是在程序：
```scheme
(if (amb #f #t)
1
(amb))
```
中，第一個`amb`表達式必須返回`#t`，如果返回`#f`，那就會執行`else`分支，這會導致整個程序掛掉。
## 14.2 用Scheme實現amb
在我們的`amb`實現中，我們令`amb`的子表達式從左向右。也就是說，我們先選擇第一個子表達式，如果不論怎樣它都失敗，那再選擇第二個，如此等等。在回溯到前一個`amb`之前，程序控制流中后面出現的`amb`也被搜索以查看所有的可能性。換句話說，我們對`amb`的選擇樹進行了一個深度優先搜索，當我們碰到失敗的情況時，我們就回溯到最近的節點來嘗試其他的選擇。（這叫做按時間順序的回溯。）
我們首先定義一個機制來處理基本的錯誤的續延：
```scheme
(define amb-fail '*)
(define initialize-amb-fail
(lambda ()
(set! amb-fail
(lambda ()
(error "amb tree exhausted")))))
(initialize-amb-fail)
```
當`amb`出錯時，它調用綁定到`amb-fail`的續延。這個續延是在所有`amb`的選擇樹都被嘗試過并且失敗的情況下調用的。
我們把`amb`定義為一個宏，接受任意數量的參數。
```scheme
(define-macro amb
(lambda alts...
`(let ((+prev-amb-fail amb-fail))
(call/cc
(lambda (+sk)
,@(map (lambda (alt)
`(call/cc
(lambda (+fk)
(set! amb-fail
(lambda ()
(set! amb-fail +prev-amb-fail)
(+fk 'fail)))
(+sk ,alt))))
alts...)
(+prev-amb-fail))))))
```
對`amb`的調用被首先存儲到`+prev-amb-fail`中，`amb-fail`的值是此時的入口。這是因為`amb-fail`變量會被隨著對可能選項的遍歷被設置為不同的失敗續延。
我們然后捕獲`amb`的入口續延`+sk`，這樣當求出一個“非失敗”的值時，它可以馬上退出`amb`。
每個序列中的選擇`alt`都被嘗試（Scheme中隱式的`begin`序列）。
首先，我們捕獲當前續延`+fk`，把它包在一個過程中并把該過程賦給`amb-fail`。接著替換物被求值`(+sk alt)`。如果`alt`的求值沒有失敗，那么把它的返回值作為參數給續延`+sk`，這樣馬上就退出了`amb`的調用。如果`alt`失敗了，就調用`amb-fail`。`amb-fail`做的第一件事是重新設置`amb-fail`為之前入口時的值。它接下來調用失敗續延`+fk`，這個續延會嘗試下個可能的選擇（如果存在的話）。
如果所有選擇都失敗了，`amb`入口的`amb-fail`（我們之前把它存放在`+prev-amb-fail`中）會被調用。
## 14.3 在Scheme中使用amb
選擇一個1到10之間的數字，我們可以這樣寫：
```scheme
(amb 1 2 3 4 5 6 7 8 9 10)
```
毫無疑問這個程序會返回1（根據我們之前實現的策略），但這個與它的上下文有關，它完全可能返回給定的任何數字。
過程`number-between`是一種生成給定`lo`到`hi`（包括`lo`和`hi`在內）之間數字的抽象方法：
```scheme
(define number-between
(lambda (lo hi)
(let loop ((i lo))
(if (> i hi) (amb)
(amb i (loop (+ i 1)))))))
```
因此`(number-between 1 6)`會首先生成1。如果失敗了，繼續循環，生成2。如果還是失敗，我們就得到3，這樣一直到6。6以后，`loop`以參數7被調用，這比6要大，調用`(amb)`。這會產生一個最終的錯誤（回憶之前我們所說的，單獨的`(amb)`肯定會出現錯誤）這時，這個包含`(number-between 1 6)`的程序會按時間順序依次回溯之前的`amb`調用，用另一種方式來滿足這個調用。
`(amb)`一定失敗的特點可以用于程序的 _斷言_ 中。
```scheme
(define assert
(lambda (pred)
(if (not pred) (amb))))
```
調用`(assert pred)`確保了`pred`為真，否則它會讓當前的`amb`選擇點失敗。
下面的程序用`assert`來生成一個小于等于其參數`hi`的素數：
```scheme
(define gen-prime
(lambda (hi)
(let ((i (number-between 2 hi)))
(assert (prime? i))
i)))
```
這看起來也太簡單了，只是當不論以任何數字（如20）調用這個過程，它永遠會給出第一個解：2。
我們當然希望得到所有的解，而不是只有第一個。這種情況下，我們會希望得到所有比20小的素數。一種方法是在該過程輸出了第一個解后，顯式地調用失敗續延。因此：
```scheme
(amb)
=> 3
```
這樣又會產生另一個失敗續延，我們還可以繼續調用它來得到另一個解。
```scheme
(amb)
=> 5
```
這種方式的問題是程序首先在Scheme的命令提示符后面被調用，并且在Scheme的命令行上調用`(amb)`也可以得到成功的解。實際上，我們正在使用不同的程序（我們無法預計到底有多少！），并把信息從前一個傳遞到下一個。相反的，我們希望可以在任意上下文中調用某種形式然后返回這些解。為此我們定義了`bag-of`宏，該宏返回其參數的所有成功實例。（如果參數永遠不能成功，就返回空列表）因此我們可以這樣寫：
```scheme
(bag-of
(gen-prime 20))
```
這樣會返回：
```scheme
(2 3 5 7 11 13 17 19)
```
宏`bag-of`定義如下：
```scheme
(define-macro bag-of
(lambda (e)
`(let ((+prev-amb-fail amb-fail)
(+results '()))
(if (call/cc
(lambda (+k)
(set! amb-fail (lambda () (+k #f)))
(let ((+v ,e))
(set! +results (cons +v +results))
(+k #t))))
(amb-fail))
(set! amb-fail +prev-amb-fail)
(reverse! +results))))
```
`bag-of`首先保存它的入口到`amb-fail`。它重新定義了`amb-fail`為一個在`if`測試中創建的本地續延。在這個測試中，`bag-of`的參數`e`被求值，如果成功，它的結果被收集到一個叫`+results`的列表，并且以`#t`為參數調用本地續延。這會讓`if`測試成功，導致`e`會在它的下一個回溯點被重新嘗試。`e`的其他結果也通過這種方法獲得并放進`+results`里。
最后，當`e`失敗時，它會調用基本的`amb-fail`，即以`#f`為參數調用本地續延。這就把控制從`if`中轉移出來。我們把`amb-fail`恢復到它上一個入口的值，并返回`+results`。（過程`reverse!`只是用來把結果以他們生成的順序展現出來）
## 14.4 邏輯謎題
在解決邏輯謎題時，這種深度優先搜索與回溯相結合的方法的強大才能明顯體現出來。這些問題用過程式的方式非常難以解決，但是可以用`amb`簡潔、直截了當的解決，而且不會減少解決問題的魅力。
### 14.4.1 Kalotan謎題
Kalotan是一個奇特的部落。這個部落里所有男人都總是講真話。所有的女人從來不會連續2句講真話，也不會連續2句都講假話。
一個哲學家（Worf）開始研究這些人。Worf不懂Kalotan的語言。一天他碰到一對Kalotan夫妻和他們的孩子Kibi。Worf問Kibi：“你是男孩嗎？”Kibi用Kalotan語回答，Worf沒聽懂。
Wrof又問孩子的父母（他們都會說英語），其中一個人說：“Kibi說：‘我是個男孩。’”，另外一個人說：“Kibi是個女孩，Kibi撒謊了”。
請問這三個Kalotan人的性別。
解決的方法包括引進一堆變量，給它們賦上各種可能的值，把所有情況列舉為一系列`assert`表達式。
變量：`parent1`,`parent2`,`kibi`分別是父母（按照說話的順序）和Kibi的性別。`kibi-self-desc`是Kibi用Kalotan語說的自己的性別。`kibi-lied?`表示Kibi是否說謊。
```scheme
(define solve-kalotan-puzzle
(lambda ()
(let ((parent1 (amb 'm 'f))
(parent2 (amb 'm 'f))
(kibi (amb 'm 'f))
(kibi-self-desc (amb 'm 'f))
(kibi-lied? (amb #t #f)))
(assert
(distinct? (list parent1 parent2)))
(assert
(if (eqv? kibi 'm)
(not kibi-lied?)))
(assert
(if kibi-lied?
(xor
(and (eqv? kibi-self-desc 'm)
(eqv? kibi 'f))
(and (eqv? kibi-self-desc 'f)
(eqv? kibi 'm)))))
(assert
(if (not kibi-lied?)
(xor
(and (eqv? kibi-self-desc 'm)
(eqv? kibi 'm))
(and (eqv? kibi-self-desc 'f)
(eqv? kibi 'f)))))
(assert
(if (eqv? parent1 'm)
(and
(eqv? kibi-self-desc 'm)
(xor
(and (eqv? kibi 'f)
(eqv? kibi-lied? #f))
(and (eqv? kibi 'm)
(eqv? kibi-lied? #t))))))
(assert
(if (eqv? parent1 'f)
(and
(eqv? kibi 'f)
(eqv? kibi-lied? #t))))
(list parent1 parent2 kibi))))
```
對于輔助過程的一些說明：`distinct?`過程返回`true`，如果其參數列表里所有參數都是不同的，否則返回`false`。過程`xor`只有當它的兩個參數一個真一個假時才返回`true`，否則返回`false`。
輸入`(solve-kalotan-puzzle)`會解決這個謎題。
### 14.4.2 地圖著色
人們很早以前就知道（但知道1976年才證明）至少用四種顏色就可以給地球的地圖著色，也就是說給所有國家著色并保證相鄰的國家的顏色是不同的。為了驗證確實是這樣的，我們編寫下面的程序，并指出非確定性編程是如何為之提供便利的。
下面的這段程序解決了西歐的地圖著色問題。這個問題和其用Prolog語言的解法在《the Art of Prolog》中給出。（如果你能比較我們與那本書里的解法應該很有益處）
過程`choose-color`非確定的返回四種顏色之一：
```scheme
(define choose-color
(lambda ()
(amb 'red 'yellow 'blue 'white)))
```
在我們的解法中，我們為每個國家建立了一個數據結構。該結構是一個三元素的列表：第一個元素表示國家名，第二個元素是顏色，第三個元素是它相鄰國家的顏色。注意我們用國家的首字母作為顏色的變量，即比利時（Belgium）的列表是`(list 'belgium b (list f h l g))`，因為——按照這個問題列表——比利時的鄰國是法國(France)，荷蘭(Holland)，盧森堡(Luxembourg)，德國(Germany)。
一旦我們給每個國家創建了列表，我們 *僅僅* 需要陳述他們應該滿足的條件，即每個國家不能與鄰國有相同的顏色。換句話說，對每個國家的列表，第二個元素的值應該不在第三個元素（列表）中。
```scheme
(define color-europe
(lambda ()
;choose colors for each country
(let ((p (choose-color)) ;Portugal
(e (choose-color)) ;Spain
(f (choose-color)) ;France
(b (choose-color)) ;Belgium
(h (choose-color)) ;Holland
(g (choose-color)) ;Germany
(l (choose-color)) ;Luxemb
(i (choose-color)) ;Italy
(s (choose-color)) ;Switz
(a (choose-color)) ;Austria
)
;construct the adjacency list for
;each country: the 1st element is
;the name of the country; the 2nd
;element is its color; the 3rd
;element is the list of its
;neighbors' colors
(let ((portugal
(list 'portugal p
(list e)))
(spain
(list 'spain e
(list f p)))
(france
(list 'france f
(list e i s b g l)))
(belgium
(list 'belgium b
(list f h l g)))
(holland
(list 'holland h
(list b g)))
(germany
(list 'germany g
(list f a s h b l)))
(luxembourg
(list 'luxembourg l
(list f b g)))
(italy
(list 'italy i
(list f a s)))
(switzerland
(list 'switzerland s
(list f i a g)))
(austria
(list 'austria a
(list i s g))))
(let ((countries
(list portugal spain
france belgium
holland germany
luxembourg
italy switzerland
austria)))
;the color of a country
;should not be the color of
;any of its neighbors
(for-each
(lambda (c)
(assert
(not (memq (cadr c)
(caddr c)))))
countries)
;output the color
;assignment
(for-each
(lambda (c)
(display (car c))
(display " ")
(display (cadr c))
(newline))
countries))))))
```
輸入`(color-europe)`來得到一個顏色-國家對應表。
----------------------------
1. SICP把這個過程命名為`require`。我們使用`assert`標識符是為了避免與用來從其他文件中加載代碼的`require`標識符混淆。
