SICP/ex-4_61-xx.scm

(load "util.scm")
(load "misc/sicp-query.scm")

(initialize-data-base microshaft-data-base)

(display "\nex-4.61 - next-to\n")

(eval-query '(append-to-form x y z))
(eval-query '(rule (append-to-form () ?y ?y)))
(eval-query
  '(rule (append-to-form (?u . ?v) ?y (?u . ?z))
         (append-to-form ?v ?y ?z)))

(eval-query '(append-to-form (a b) (c d) ?z)) (newline)
; (eval-query '(append-to-form (a b) ?y (a b c d))) (newline)
; (eval-query '(append-to-form ?x ?y (a b c d))) (newline)

(eval-query '(rule (?x next-to ?y in (?x ?y . ?u))))

(eval-query
  '(rule (?x next-to ?y in (?v . ?z))
         (?x next-to ?y in ?z)))

; (eval-query '(?x next-to ?y in (1 (2 3) 4))) (newline)
; (1 next-to (2 3))
; ((2 3) next-to  4)

; (eval-query '(?x next-to 1 in (2 1 3 1))) (newline)
; (2 next-to 1)
; (3 next-to 1)

(display "[answered]\n")

(display "\nex-4.62 - last-pair\n")

(eval-query '(rule (last-pair (?x . ()) (?x . ()))))
(eval-query
  '(rule (last-pair (?u . ?v) ?x)
         (last-pair ?v ?x)))

(eval-query '(last-pair (1 2 3) ?y))
(eval-query '(last-pair (3) ?y))
(eval-query '(last-pair (2 3 4 5 ?x) (3)))
(newline)

; (eval-query '(last-pair ?x (3))) results in an endless loop because there is
; no definite answer. Any arbitrary number of symbols before the 3 would form a
; solution.

(display "\nex-4.63 - genesis-family\n")

; Formulate rules such as ``If S is the son of F, and F is the son of G, then S
; is the grandson of G'' and ``If W is the wife of M, and S is the son of W,
; then S is the son of M'' (which was supposedly more true in biblical times
; than today) that will enable the query system to find the grandson of Cain;
; the sons of Lamech; the grandsons of Methushael. (See exercise 4.69 for some
; rules to deduce more complicated relationships.)

(eval-query '(rule (grandson ?grandparent ?grandson)
                   (and (nson ?grandparent ?son)
                        (nson ?son ?grandson))))

(eval-query '(rule (nson ?parent ?son)
                   (or (son ?parent ?son)
                       (and (wife ?parent ?wife)
                            (son ?wife ?son)))))

(eval-query '(grandson Cain ?x))
(eval-query '(nson Lamech ?x))
(eval-query '(grandson Methushael ?x))
(newline)

(display "\nex-4.64\n")

(display "\nex-4.65\n")