这次回顾第四章第六部分习题。

学习资料：

https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/index.htm

https://github.com/DeathKing/Learning-SICP

https://mitpress.mit.edu/sites/default/files/sicp/index.html

https://www.bilibili.com/video/BV1Xx41117tr?from=search&seid=14983483066585274454

参考资料：

https://sicp.readthedocs.io/en/latest

http://community.schemewiki.org/?SICP-Solutions

http://community.schemewiki.org/?sicp

https://liujiacai.net/blog/2016/02/22/recursion-without-name/

https://mvanier.livejournal.com/2897.html

https://github.com/jiacai2050/sicp

https://liujiacai.net/

4.55(p309)

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

; (a)
(supervisor ?person (Bitdiddle Ben))

; (b)
(job ?person (accounting . ?other))

; (c)
(address ?person (Slumerville . ?other))

结果：

;;; Query input:
; (a)
(supervisor ?person (Bitdiddle Ben))
;;; Query results:
(supervisor (tweakit lem e) (bitdiddle ben))
(supervisor (fect cy d) (bitdiddle ben))
(supervisor (hacker alyssa p) (bitdiddle ben))

;;; Query input:
; (b)
(job ?person (accounting . ?other))
;;; Query results:
(job (cratchet robert) (accounting scrivener))
(job (scrooge eben) (accounting chief accountant))

;;; Query input:
; (c)
(address ?person (Slumerville . ?other))
;;; Query results:
(address (aull dewitt) (slumerville (onion square) 5))
(address (reasoner louis) (slumerville (pine tree road) 80))
(address (bitdiddle ben) (slumerville (ridge road) 10))

4.56(p311)

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

; (a)
(and (supervisor ?person (Bitdiddle Ben))
     (address ?person ?where))

; (b)
(and (salary (Bitdiddle Ben) ?amount1) 
     (salary ?person ?amount2)
     (lisp-value < ?amount2 ?amount1))

; (c)
; 和顺序有关
(and (not (job ?x (computer . ?other)))
     (supervisor ?y ?x)
     (job ?y ?job))

(and (supervisor ?y ?x)
     (not (job ?x (computer . ?other)))
     (job ?y ?job))

结果：

;;; Query input:
; (a)
(and (supervisor ?person (Bitdiddle Ben))
     (address ?person ?where))
;;; Query results:
(and (supervisor (tweakit lem e) (bitdiddle ben)) (address (tweakit lem e) (boston (bay state road) 22)))
(and (supervisor (fect cy d) (bitdiddle ben)) (address (fect cy d) (cambridge (ames street) 3)))
(and (supervisor (hacker alyssa p) (bitdiddle ben)) (address (hacker alyssa p) (cambridge (mass ave) 78)))

;;; Query input:
; (b)
(and (salary (Bitdiddle Ben) ?amount1) 
     (salary ?person ?amount2)
     (lisp-value < ?amount2 ?amount1))
;;; Query results:
(and (salary (bitdiddle ben) 60000) (salary (aull dewitt) 25000) (lisp-value < 25000 60000))
(and (salary (bitdiddle ben) 60000) (salary (cratchet robert) 18000) (lisp-value < 18000 60000))
(and (salary (bitdiddle ben) 60000) (salary (reasoner louis) 30000) (lisp-value < 30000 60000))
(and (salary (bitdiddle ben) 60000) (salary (tweakit lem e) 25000) (lisp-value < 25000 60000))
(and (salary (bitdiddle ben) 60000) (salary (fect cy d) 35000) (lisp-value < 35000 60000))
(and (salary (bitdiddle ben) 60000) (salary (hacker alyssa p) 40000) (lisp-value < 40000 60000))

;;; Query input:
; (c)
; 和顺序有关
(and (not (job ?x (computer . ?other)))
     (supervisor ?y ?x)
     (job ?y ?job))
;;; Query results:

;;; Query input:
(and (supervisor ?y ?x)
     (not (job ?x (computer . ?other)))
     (job ?y ?job))
;;; Query results:
(and (supervisor (aull dewitt) (warbucks oliver)) (not (job (warbucks oliver) (computer . ?other))) (job (aull dewitt) (administration secretary)))
(and (supervisor (cratchet robert) (scrooge eben)) (not (job (scrooge eben) (computer . ?other))) (job (cratchet robert) (accounting scrivener)))
(and (supervisor (scrooge eben) (warbucks oliver)) (not (job (warbucks oliver) (computer . ?other))) (job (scrooge eben) (accounting chief accountant)))
(and (supervisor (bitdiddle ben) (warbucks oliver)) (not (job (warbucks oliver) (computer . ?other))) (job (bitdiddle ben) (computer wizard)))

4.57(p312)

备注：规则需要在ch4-query.scm中添加。

新增规则：

; 4.57 add
(rule (replace ?p1 ?p2)
      (and (job ?p1 ?job1)
           (job ?p2 ?job2)
           (or (same ?job1 ?job2)
               (can-do-job ?job1 ?job2))
           (not (same ?p1 ?p2))))

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

; (a)
(replace ?person (Fect Cy D))

; (b)
(and (replace ?p1 ?p2)
     (salary ?p1 ?m1)
     (salary ?p2 ?m2)
     (lisp-value < ?m1 ?m2))

实验结果：

;;; Query input:
; (a)
(replace ?person (Fect Cy D))
;;; Query results:
(replace (bitdiddle ben) (fect cy d))
(replace (hacker alyssa p) (fect cy d))

;;; Query input:
; (b)
(and (replace ?p1 ?p2)
     (salary ?p1 ?m1)
     (salary ?p2 ?m2)
     (lisp-value < ?m1 ?m2))
;;; Query results:
(and (replace (aull dewitt) (warbucks oliver)) (salary (aull dewitt) 25000) (salary (warbucks oliver) 150000) (lisp-value < 25000 150000))
(and (replace (fect cy d) (hacker alyssa p)) (salary (fect cy d) 35000) (salary (hacker alyssa p) 40000) (lisp-value < 35000 40000))

4.58(p312)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.58

新增规则：

; 4.58 add
; 规则不能重复定义
(rule (big-names ?person ?department)
      (and (job ?person (?department . ?o1))
          (or (not (supervisor ?person ?boss))
              (and (supervisor ?person ?boss)
                   (not (job ?boss (?department . ?o2)))))))

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

(big-names ?person ?department)

实验结果：

;;; Query input:
(big-names ?person ?department)
;;; Query results:
(big-names (warbucks oliver) administration)
(big-names (scrooge eben) accounting)
(big-names (bitdiddle ben) computer)

4.59(p312)

新增规则：

; 4.59 add
(meeting accounting (Monday 9am))
(meeting administration (Monday 10am))
(meeting computer (Wednesday 3pm))
(meeting administration (Friday 1pm))
(meeting whole-company (Wednesday 4pm))

(rule (meeting-time ?person ?day-and-time)
      (and (job ?person (?department . ?other))
           (or (meeting whole-company ?day-and-time)
               (meeting ?department ?day-and-time))))

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

; (a)
(meeting ?name (Friday ?time))

; (b)
(meeting-time (aull dewitt) ?day-and-time)

; (c)
(meeting-time (Hacker Alyssa P) ?day-and-time)

实验结果：

;;; Query input:
; (a)
(meeting ?name (Friday ?time))
;;; Query results:
(meeting administration (friday 1pm))

;;; Query input:
; (b)
(meeting-time (aull dewitt) ?day-and-time)
;;; Query results:
(meeting-time (aull dewitt) (wednesday 4pm))
(meeting-time (aull dewitt) (friday 1pm))
(meeting-time (aull dewitt) (monday 10am))

;;; Query input:
; (c)
(meeting-time (Hacker Alyssa P) ?day-and-time)
;;; Query results:
(meeting-time (hacker alyssa p) (wednesday 4pm))
(meeting-time (hacker alyssa p) (wednesday 3pm))

4.60(p313)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.60

lives-near的代码：

(rule (lives-near ?person-1 ?person-2)
      (and (address ?person-1 (?town . ?rest-1))
           (address ?person-2 (?town . ?rest-2))
           (not (same ?person-1 ?person-2))))

注意person-1, person-2是对称的，所以会出现两次，要使得每对结果只出现一次，应该对每一对内的结果增加排序。

添加的规则：

; not in microshaft-data-base
; 4.60 add
(define (person->string person)
  (if (null? person)
    ""
    (string-append (symbol->string (car person)) (person->string (cdr person)))))

(define (person>? p1 p2)
  (string>? (person->string p1) (person->string p2)))

; in microshaft-data-base
; 4.60 add
(rule (lives-near-unique ?person-1 ?person-2)
      (and (address ?person-1 (?town . ?rest-1))
           (address ?person-2 (?town . ?rest-2))
           (not (same ?person-1 ?person-2))
           (lisp-value person>? ?person-1 ?person-2)))

实验结果：

;;; Query input:
(lives-near-unique ?person-1 ?person-2)
;;; Query results:
(lives-near-unique (reasoner louis) (aull dewitt))
(lives-near-unique (reasoner louis) (bitdiddle ben))
(lives-near-unique (hacker alyssa p) (fect cy d))
(lives-near-unique (bitdiddle ben) (aull dewitt))

4.61(p314)

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

(?x next-to ?y in (1 (2 3) 4))
(?x next-to 1 in (2 1 3 1))

实验结果：

;;; Query input:
(?x next-to ?y in (1 (2 3) 4))
;;; Query results:
((2 3) next-to 4 in (1 (2 3) 4))
(1 next-to (2 3) in (1 (2 3) 4))

;;; Query input:
(?x next-to 1 in (2 1 3 1))
;;; Query results:
(3 next-to 1 in (2 1 3 1))
(2 next-to 1 in (2 1 3 1))

4.62(p314)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.62

添加的规则：

; 4.62 add
(rule (last-pair (?x) ?x))
(rule (last-pair (?u . ?v) ?x)
      (last-pair ?v ?x))

代码：

(load "ch4-query.scm")

(initialize-data-base microshaft-data-base)
(query-driver-loop)

(last-pair (3) ?x)
(last-pair (1 2 3) ?x)
(last-pair (2 ?x) (3))

; 死循环
; (last-pair ?x (3))

结果：

;;; Query input:
(last-pair (3) ?x)
;;; Query results:
(last-pair (3) 3)

;;; Query input:
(last-pair (1 2 3) ?x)
;;; Query results:
(last-pair (1 2 3) 3)

;;; Query input:
(last-pair (2 ?x) (3))
;;; Query results:
(last-pair (2 (3)) (3))

4.63(p314)

备注：

这里

(relation a b)

可以理解为

a's relation is b

添加的规则：

; 4.63
(son Adam Cain)
(son Cain Enoch)
(son Enoch Irad)
(son Irad Mehujael)
(son Mehujael Methushael)
(son Methushael Lamech)
(wife Lamech Ada)
(son Ada Jabal)
(son Ada Jubal)

(rule (son? ?x ?y)
      (or (son ?x ?y)
          (and (wife ?z ?x)
               (son ?z ?y))
          (and (wife ?x ?z)
               (son ?z ?y))))

(rule (grandson? ?x ?y)
      (and (son? ?x ?z)
           (son? ?z ?y)))

结果：

;;; Query input:
(son? Lamech ?name)
;;; Query results:
(son? lamech jubal)
(son? lamech jabal)

;;; Query input:
(son? Ada ?name)
;;; Query results:
(son? ada jubal)
(son? ada jabal)

;;; Query input:
(grandson? ?name Methushael)
;;; Query results:
(grandson? irad methushael)

;;; Query input:
(grandson? Methushael ?name)
;;; Query results:
(grandson? methushael jubal)
(grandson? methushael jabal)