(load "shared/util.scm")
(load "shared/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))