exerise 4.55-69

SICP exercise

もうblogじゃないね、ここのサイト....。(今更)
ただの演習うp場になっとる。
ちなみに部活の読書会で4章読み終わるなどしてたり。5章はどうなるんかなー。まぁそれはともかく、せめて4章の演習は終わらせたい。あと少しだしね。
てな訳で以下解答。
ちなみに今回はすんごい手抜きだよっ！

;; ex 4.4

;;4.55
;;順にa,b,c
(supervisor ?x (Bitdiddle Ben))
(job ?x (accounting . ?y))
(address ?x (Slumerville . ?y))


;;4.56
;;そのまんま
(and (supervisor ?person (Bitdiddle Ben))
     (address ?person ?where))
(and (salary (Bitdiddle Ben) ?amount-1)
     (salary ?person ?amount-2)
     (lisp-value > ?amount-1 ?amount-2))
(and (supervisor ?person-1 ?person-2)
     (job ?person-2 ?x)
     (not (job ?person-2 (computer . ?y))))

;;57
(assert!
 (rule (can-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)))))

(can-replace ?person (Fect Cy D))

(and (can-replace ?person-1 ?person-2)
     (salary ?person-1 ?amount-1)
     (salary ?person-2 ?amount-2)
     (lisp-value < ?amount-1 ?amount-2))

;;58
(assert!
 (rule (big-shot ?person-1)
       (and (job ?person-1 (?type-1 . ?rest-1))
            (not (and (supervisor ?person-1 ?person-2)
                      (job ?person-2  (?type-2 . ?rest-2))
                      (same ?type-1 ?type-2))))))

(big-shot ?x)

;;59

(assert! (meeting accounting (Monday 9am)))
(assert! (meeting administration (Monday 10am)))
(assert! (meeting computer (Wednesday 3pm)))
(assert! (meeting administration (Friday 1pm)))
(assert! (meeting whole-company (Wednesday 4pm)))

(meeting ?x (Friday . ?y))

(assert!
 (rule (meeting-time ?person ?day-and-time)
       (and (job ?person (?type . ?rest))
            (or (meeting whole-company ?day-and-time)
                (meeting ?type ?day-and-time)))))

(meeting-time (Hacker Alyssa P) (Wednesday . ?time))

;;60
;; 番号付けして若い順にする
;; 名前をsymbolからstringにしてから比較する案もあるが
;; それだと同姓同名が問題となってしまう。

;;61
(assert! (rule (?x next-to ?y in (?x ?y . ?u))))

(assert! (rule (?x next-to ?y in (?v . ?z))
               (?x next-to ?y in ?z)))

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

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

;;62
(assert! (rule (last-pair (?x) (?x))))
(assert! (rule (last-pair (?x . ?y) ?z)
               (last-pair ?y ?z)))

;;63
(assert!
 (rule (son-of ?p ?s)
       (or (son ?p ?s)
           (and (wife ?p ?f)
                (son ?f ?s)))))

(assert!
 (rule (grandson ?g ?s)
       (and (son-of ?p ?s)
            (son-of ?g ?p))))

;;64
;;自明・・・じゃだめか。まぁ普通にループするよね

;;65 そりゃそうだろ。真面目に追ってけば分かる。

;;66
;;65の場合とかだと揉める

;;67
;;queryの履歴を作って、それをチェックしつつループ回すのかな？
;;実装まだなので更に具体的な内容はパス。

;;68
;; (reverse (1 2 3) ?x) と (reverse ?x (1 2 3))
;; の両方を解かせるのは無理(？)
;; 必ず片方無限ループに

(assert!
 (rule (lreverse () ())))

(assert!
 (rule (lreverse (?x . ?y) ?z)
       (and (lreverse ?y ?w)
            (append-to-form ?w (?x) ?z))))

(assert!
 (rule (rreverse () ())))

(assert!
 (rule (rreverse ?z (?x . ?y))
       (and (lreverse ?y ?w)
            (append-to-form ?w (?x) ?z))))

;;69

;;from 62&63
;;62
(assert!
 (rule (last-pair (?x) (?x))))
(assert!
 (rule (last-pair (?x . ?y) ?z)
       (last-pair ?y ?z)))
(assert!
 (rule (son-of ?p ?s)
       (or (son ?p ?s)
           (and (wife ?p ?f)
                (son ?f ?s)))))
(assert!
 (rule (grandson ?g ?s)
       (and (son-of ?p ?s)
            (son-of ?g ?p))))

;;ver1 汚い
(assert!
 (rule ((great . ?rel) ?x ?y)
       (or (and (last-pair ?rel ?rel)
                (last-pair ?rel (?r))
                (son-of ?x ?z)
                (?r ?z ?y))
           (and (son-of ?x ?z)
                (?rel ?z ?y)))))

;;((grandson) ..) とすると
(assert!
 (rule ((grandson) ?g ?s)
       (and (son-of ?p ?s)
            (son-of ?g ?p))))

;;マシになったかな。
(assert!
 (rule ((great . ?rel) ?x ?y)
       (and (son-of ?x ?z)
            (?rel ?z ?y))))

実行例パスするのは始めてかも。
まぁそもそもここ見る人少ないし問題な(ry