119 lines
3.6 KiB
Scheme
119 lines
3.6 KiB
Scheme
(load "util.scm")
|
|
(load "misc/sicp-query.scm")
|
|
|
|
(initialize-data-base microshaft-data-base)
|
|
|
|
(display "\nex-4.55 - simple-queries\n")
|
|
|
|
; a. all people supervised by Ben Bitdiddle;
|
|
(eval-query '(supervisor ?x (bitdiddle ben)))
|
|
(newline)
|
|
|
|
; b. the names and jobs of all people in the accounting division;
|
|
(eval-query '(job ?x (accounting . ?y)))
|
|
(newline)
|
|
|
|
; c. the names and addresses of all people who live in Slumerville.
|
|
(eval-query '(address ?x (slumerville . ?y)))
|
|
(newline)
|
|
|
|
(display "\nex-4.56 - joint-queries\n")
|
|
|
|
; a. the names of all people who are supervised by Ben Bitdiddle, together with
|
|
; their addresses;
|
|
(eval-query
|
|
'(and (supervisor ?person (Bitdiddle Ben))
|
|
(address ?person ?address)))
|
|
(newline)
|
|
|
|
; b. all people whose salary is less than Ben Bitdiddle's, together with their
|
|
; salary and Ben Bitdiddle's salary;
|
|
(eval-query
|
|
'(and (salary (Bitdiddle Ben) ?ben-amount)
|
|
(salary ?person ?amount)
|
|
(lisp-value > ?amount ?ben-amount)))
|
|
(newline)
|
|
; c. all people who are supervised by someone who is not in the computer ; division, together with the supervisor's name and job. (eval-query
|
|
'(and (supervisor ?person ?supervisor)
|
|
(not (job ?supervisor (computer . ?supervisor-title)))
|
|
(job ?supervisor ?job)))
|
|
(newline)
|
|
|
|
(display "\nex-4.57 - rules\n")
|
|
|
|
(eval-query
|
|
'(rule (can-replace ?p1 ?p2)
|
|
(and (or (and (job ?p1 ?j) (job ?p2 ?j))
|
|
(and (job ?p1 ?j1)
|
|
(job ?p2 ?j2)
|
|
(can-do-job ?j1 ?j2)))
|
|
(not (same ?p1 ?p2)))))
|
|
|
|
; a. all people who can replace Cy D. Fect;
|
|
(eval-query '(can-replace (fect cy d) ?x))
|
|
(newline)
|
|
|
|
; b. all people who can replace someone who is being paid more than they are,
|
|
; together with the two salaries.
|
|
(eval-query
|
|
'(and (can-replace ?p1 ?p2)
|
|
(salary ?p1 ?s1)
|
|
(salary ?p2 ?s2)
|
|
(lisp-value < ?s1 ?s2)))
|
|
(newline)
|
|
|
|
(display "\nex-4.58 - big-shot\n")
|
|
|
|
; Exercise 4.58. Define a rule that says that a person is a ``big shot'' in a
|
|
; division if the person works in the division but does not have a supervisor
|
|
; who works in the division.
|
|
|
|
(eval-query
|
|
'(rule (big-shot ?p)
|
|
(and (job ?p (?div1 . ?rest1))
|
|
(supervisor ?p ?boss)
|
|
(job ?boss (?div2 . ?rest2))
|
|
(not (same ?div1 ?div2)))))
|
|
|
|
(eval-query '(big-shot ?x))
|
|
(newline)
|
|
|
|
(display "\nex-4.59 - meetings\n")
|
|
|
|
; a. On Friday morning, Ben wants to query the data base for all the meetings
|
|
; that occur that day. What query should he use?
|
|
(eval-query
|
|
'(meeting ?department (Friday . ?time)))
|
|
(newline)
|
|
|
|
(eval-query
|
|
'(rule (meeting-time ?person ?day-and-time)
|
|
(and (job ?person (?department . ?title))
|
|
(or (meeting ?department ?day-and-time)
|
|
(meeting whole-company ?day-and-time)))))
|
|
|
|
(eval-query
|
|
'(meeting-time (hacker alyssa p) (Wednesday . ?time)))
|
|
(newline)
|
|
|
|
(display "\nex-4.60 - double-pair\n")
|
|
|
|
; Each pair of people who live close to each other is listed twice:
|
|
;(eval-query '(lives-near ?person-1 ?person-2))
|
|
|
|
; This happens because the query does not impose an order on the two arguments.
|
|
; Each variable can assign to either person. One way to avoid this would be to
|
|
; impose an ordering on the persons, for example alphabetical or by id.
|
|
|
|
(eval-query
|
|
'(rule (lives-near-unique ?person-1 ?person-2)
|
|
(and (address ?person-1 (?town . ?rest-1))
|
|
(address ?person-2 (?town . ?rest-2))
|
|
(id ?person-1 ?id-1)
|
|
(id ?person-2 ?id-2)
|
|
(lisp-value > ?id-2 ?id-1)
|
|
(not (same ?person-1 ?person-2)))))
|
|
|
|
(eval-query '(lives-near-unique ?person-1 ?person-2))
|
|
|