第四章习题 4.38 - 4.79 的解答。由于 amb 环境没实现，程序没跑起来，跳过了 4.3 小节的部分题目。
E-4.38: 去掉题目的条件后有5种可能性，分别是：
baker = 1, cooper = 2, fletcher = 4, miller = 3, smith = 5
baker = 1, cooper = 2, fletcher = 4, miller = 5, smith = 3
baker = 1, cooper = 4, fletcher = 2, miller = 5, smith = 3
baker = 3, cooper = 2, fletcher = 4, miller = 5, smith = 1
baker = 3, cooper = 4, fletcher = 2, miller = 5, smith = 1
好吧，请看 4.41 的解答……
E-4.39: 条件的顺序不影响最终的结果，因为所有条件都必须满足；但是会影响找到结果的时间，因为根据匹配的顺序不同，进入的分支深度不一样。
E-4.40:
(define (distinct? items)
(cond ((null? items) true)
((null? (cdr items)) true)
((member (car items) (cdr items)) false)
(else (distinct? (cdr items)))))
(define (multiple-dwelling)
(let ((baker (amb 1 2 3 4 5)))
(if (not (= baker 5))
(let ((cooper (amb 1 2 3 4 5)))
(if (not (= cooper 1))
(let ((fletcher (amb 1 2 3 4 5)))
(if (and (not (= fletcher 1))
(not (= fletcher 5)))
(let ((miller (amb 1 2 3 4 5)))
(if (> miller cooper)
(let ((smith (amb 1 2 3 4 5)))
(if (and (distinct? (list baker cooper fletcher miller smith))
(= (abs (- smith fletcher)) 1)
(= (abs (- fletcher cooper)) 1))
(display "ok\n"))))))))))))
E-4.41:
(load "4.40.scm")
(define (multiple-dwelling)
(define result-set (list 1 2 3 4 5))
(map (lambda (baker)
(if (not (= baker 5))
(map (lambda (cooper)
(if (not (= cooper 1))
(map (lambda (fletcher)
(if (and (not (= fletcher 1))
(not (= fletcher 5)))
(map (lambda (miller)
(if (> miller cooper)
(map (lambda (smith)
(if (and (distinct? (list baker cooper fletcher miller smith))
(not (= (abs (- smith fletcher)) 1))
(not (= (abs (- fletcher cooper)) 1)))
(map display (list "\n"
"baker = " baker
", cooper = " cooper
", fletcher = " fletcher
", miller = " miller
", smith = " smith "\n"))))
result-set)))
result-set)))
result-set)))
result-set)))
result-set))
(multiple-dwelling)
E-4.42: betty = 3, ethel = 5, joan = 2, kitty = 1, marry = 4
(load "4.40.scm")
(define (betty-and-kitty? betty kitty)
(and (not (= betty kitty))
(if (= kitty 2)
(not (= betty 3))
(= betty 3))))
(define (ethel-and-joan? ethel joan)
(and (not (= ethel joan))
(if (= ethel 1)
(not (= joan 2))
(= joan 2))))
(define (joan-and-ethel? joan ethel)
(and (not (= joan ethel))
(if (= joan 3)
(not (= ethel 5))
(= ethel 5))))
(define (kitty-and-marry? kitty marry)
(and (not (= kitty marry))
(if (= kitty 2)
(not (= marry 4))
(= marry 4))))
(define (marry-and-betty? marry betty)
(and (not (= marry betty))
(if (= marry 4)
(not (= betty 1))
(= betty 1))))
(define (liars)
(define result-set (list 1 2 3 4 5))
(map (lambda (betty)
(map (lambda (kitty)
(if (betty-and-kitty? betty kitty)
(map (lambda (marry)
(if (and (marry-and-betty? marry betty)
(kitty-and-marry? kitty marry))
(map (lambda (ethel)
(map (lambda (joan)
(if (and (distinct? (list betty kitty marry ethel joan))
(joan-and-ethel? joan ethel)
(ethel-and-joan? ethel joan))
(map display (list
"betty = " betty
", ethel = " ethel
", joan = " joan
", kitty = " kitty
", marry = " marry "\n"))))
result-set))
result-set)))
result-set)))
result-set))
result-set))
(liars)
E-4.43: 真受不了老外的名字......
(define mary 1)
(define gabrielle 2)
(define lorna 3)
(define rosalind 4)
(define melissa 5)
(define (find-my-daughter)
(let ((moore (amb mary gabrielle lorna rosalind melissa))
(downing (amb mary gabrielle lorna rosalind melissa))
(hall (amb mary gabrielle lorna rosalind melissa))
(barnacle (amb mary gabrielle lorna rosalind melissa))
(parker (amb mary gabrielle lorna rosalind melissa)))
(require
(distinct? (list moore downing hall barnacle parker))
(= moore mary)
(not (= barnacle gabrielle))
(not (= hall rosalind))
(not (= downing melissa))
(= barnacle melissa))))
最后一个条件没有用上。感觉船的拥有关系除了起到排除的作用之外没有什么确定的作用。
E-4.44, E-4.45: 跳过了。
E-4.46: 因为语法分析是从左往右进行的，如果顺序乱了，取到的单词顺序不一样，分析出来的结果就不对了。
E-4.47: 有可能会进入死循环。如果第一个“(parse-word verbs)”不成立，amb 会执行第二个语句，而这个语句又递归调用了自身，结果还是不成立。
E-4.48: 跳过了。
E-4.49: 将分析到的单词换成另一个单词。
(define (parse-word word-list)
(list (car word-list)
(an-element-of (cdr word-list))))
```scheme
E-4.50 - E-4.54: 跳过。
E-4.55:
1. (supervisor ?x (Bitdiddle Ben))
2. (job ?x (accounting . ?y))
3. (address ?x (Slumerville . ?y))
E-4.56:
a. (and (supervisor ?x (Bitdiddle Ben))
(address ?x . ?y))
b. (and (salary (Bitdiddle Ben) ?Ben-salary)
(salary ?person ?amount)
(list-value < ?amount ?Ben-salary))
c. (and (not (job ?person (computer . ?y)))
(supervisor ?person ?x))
E-4.57:
```scheme
(rule (replace ?person-1 ?person-2)
(and (job ?person-1 ?job-1)
(job ?person-2 ?job-2)
(or (same ?job-1 ?job-2)
(can-do-job ?job-1 ?job-2))
(not (same (?person-1 ?person-2)))))
; a.
(replace ?person (Fect Cy D))
; b.
(and (replace ?person-1 ?person-2)
(salary ?person-1 ?amount-1)
(salary ?person-2 ?amount-2)
(lisp-value > ?amount-2 ?amount-1))
E-4.58:
(rule (big-shot ?person)
(and (job ?person (?division . ?type))
(supervisor ?x ?person)
(not (job ?x (?division . ?x-type)))))
E-4.59:
; a.
(meeting ?anybody (Friday ?time))
; b.
(rule (meeting-time ?persion ?day-and-time)
(and (meeting whole-company ?day-and-time)
(job ?persion (?division . ?rest))
(meeting ?division ?day-and-time)))
; c.
(meeting-time (Hacker Alyssa P) (Wednesday . ?rest))
E-4.60: 将所有人的距离做成一个二维矩阵，猜测lives-near的可能实现为对所有人的距离都两两进行比较。如果要消除重复记录，只需对角线以上或以下的元素进行比较即可。
E-4.61: 或者规则可以写成这样？
(rule (?x next-to ?y in (?v . ?x ?y . ?u)))
1 (2 3), (2 3) 4
2, 3
E-4.62: 和数学归纳法一样，先设置第一个条件，然后是递推条件。
(rule (last-pair (?x) (?x)))
(rule (last-pair (?u . ?v) ?x)
(last-pair ?v ?x))
“(last-pair ?x (3))”会死循环，因为有无数符合条件的组合。
E-4.63: 没有西方文化的背景几乎无法理解这个题……还好题目中一个关键词“back”，加上对亚当和夏娃故事的印象，猜测 son 的意思应该是"(son ?father ?son)"。好了有点跑题了……
(rule (grandson ?G ?S)
(and (son ?f ?S) (son ?G ?f)))
(rule (son ?M ?S)
(and (wife ?W ?M)
(son ?S ?W)))
E-4.64: 我觉得是这样的一个流程：
- 第一次判断，?staff-person 绑定为 (Bitdiddle Ben)，?who 和 ?boss 绑定；
- 进入内层的 and 分支的 outranked 时，?boss 绑定为 ?who，但是 ?middle-manager 没有绑定，这时就会把所有的 ?staff-person 都找出来；
- 对每个雇员和 ?boss 和 ?staff-person 递归调用 outranked，结果就死循环了。
死循环的原因在于 ?middle-manager 没有绑定。
E-4.65: 因为 Oliver Warbucks 手下有好几个 middle-manager，“(wheel ...)”的第一个条件把他手下的 middle-manager 都列出来，而且这些 middle-manager 都满足第二个条件。
E-4.66: 既然会出现重复条目，最后的结果自然是不对的。可以先对 query 结果去重后再执行 accumulation。
E-4.67: 想到的一个方法是，记录下每个函数每次执行时已经绑定的条件。如果后续的执行中发现和之前曾经执行过的情况一样（执行的函数和对应绑定的变量），就可以认为产生了环。
E-4.68:
(rule (reverse () ()))
(rule (reverse ?req ?res)
(reverse (lisp-value cdr ?req) ?res1)
(reverse (lisp-value car ?req) ?res2)
(append-to-form ?res1 ?res2 ?res))
这样的实现只能回答已知 req 求 res 的情况，反过来就不行了。如果已知 res 求 req，从第一和第二个 reverse 条件来看会有无限多种情况。
E-4.69: 见参考资料 [1]。
(rule (ends-with-grandson ?x)
(append-to-form ?head (grandson) ?x))
(rule ((great . ?rel) ?x ?y)
(and
(ends-with-grandson ?rel)
(?rel ?sx ?y)
(son ?x ?sx)))
E-4.70: let 的作用是保证 THE-ASSERTIONS 被计算。因为 stream 操作是延迟操作，如果没有 let 语句，每次 set! 后 THE-ASSERTIONS 的值都是最新的 assertion，旧的值被覆盖了。
E-4.71: delay 可以避免出现死循环产生无数的 frame，例如前面提到的例子“(married ...)”。
E-4.72: 与上一题的原因一样，可能出现无数的 frame。
E-4.73: flatten-stream 每次都会从 (stream-car ...) 取出一个元素，完全没有 delay 的效果。
E-4.74: 结果不会改变。
(define (simple-stream-flatmap proc s)
(simple-flatten (stream-map proc s)))
(define (simple-flatten stream)
(stream-map stream-car
(stream-filter (lambda (frame) (not (stream-null? frame))) stream)))
E-4.75:
(define (uniquely-asserted query stream)
(stream-flatmap
(lambda (frame)
(let ((result (qeval query (singleton-stream frame))))
(if (and (not (null? (car result)))
(null? (cdr result)))
the-empty-stream
result)))
stream))
E-4.76: 每次 conjoin 的时候分别算 first 和 rest，然后对 first 和 rest 进行 join。
(define (conjoin conjuncts frame-stream)
(define (recur first-frame-stream rest-frame-stream)
(if (stream-null? rest-frame-stream)
first-frame-stream
(recur (join first-frame-stream (stream-car rest-frame-stream))
(stream-cdr rest-frame-stream))))
(if (empty-conjunction? conjuncts)
frame-stream
(let ((first (qeval (first-conjunct conjuncts) frame-stream))
(rest (qeval (rest-conjncts conjuncts) frame-stream)))
(recur first rest))))
E-4.77 - 4.79: 跳过。