sicp-4-4-1-deductive-information-retrieval

#lang racket

;; You cannot run this file.  These are not Racket expressions.

;;;;;;;;;;
;; 4.55 ;;
;;;;;;;;;;

;; a. all people supervised by ben bitdiddle
(supervisor ?person (Bitdiddle Ben))

;; b. the names and jobs of all people in accounting
(job ?person (accounting . ?job))

;; c. the names and adresses of all people who live in slumerville
(address ?person (Slumerville . ?address))

;;;;;;;;;;
;; 4.56 ;;
;;;;;;;;;;

;; a. the names of all people supervised by ben bitdiddle with addresses
(and (supervisor ?person (Bitdiddle Ben))
     (address ?person ?address))

;; b. all people with salary < ben's salary plus their salary plus ben's salary
(and (salary ?person ?amount)
     (salary (Bitdiddle Ben) ?ben-salary)
     (lisp-value < ?amount ?ben-salary))

;; c. all people supervised by person not in computer plus supervisor's name and job
(and (supervisor ?person1 ?person2)
     (not (job ?person2 (computer . ?type)))
     (job ?person2 ?job))

;;;;;;;;;;
;; 4.57 ;;
;;;;;;;;;;

(rule (can-replace ?person1 ?person2)
      (and (job ?person1 ?job1)
           (job ?person2 ?job2)
           (or (same ?job1 ?job2)
               (can-do-job ?job1 ?job2))
           (not (same ?person1 ?person2))))

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

(and (salary ?person1 ?amount1)
     (salary ?person2 ?amount2)
     (can-replace ?person1 ?person2)
     (lisp-value < ?amount1 ?amount2))

;;;;;;;;;;
;; 4.58 ;;
;;;;;;;;;;

(rule (has-supervisor-in-department ?person ?department)
      (and (job ?person (?department . ?type))
           (job ?person2 (?department . ?type2))
           (supervisor ?person ?person2)))

(rule (big-shot ?person ?department)
      (and (job ?person (?department . ?type))
           (not (has-supervisor-in-department ?person ?department))))

;;;;;;;;;;
;; 4.59 ;;
;;;;;;;;;;

(meeting ?who (Friday . ?when))

(rule (meeting-time ?person ?day-and-time)
      (and (job ?person (?department . ?type))
           (meeting ?who ?day-and-time2)
           (or (same ?who ?department)
               (same ?who whole-company))))

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

;;;;;;;;;;
;; 4.60 ;;
;;;;;;;;;;

;; Impose a total ordering on people and accept only ordered pairs.

(define (comes-before? name1 name2) ; names are lists of symbols
  (define last-name1 (symbol->string (first name1)))
  (define first-name1 (symbol->string (second name1)))
  (define last-name2 (symbol->string (first name2)))
  (define first-name2 (symbol->string (second name2)))
  (or (string<? last-name1 last-name2)
      (and (string=? last-name1 last-name2)
           (string<? first-name1 first-name2))))

(rule (lives-near2 ?person1 ?person2)
      (and (lives-near ?person1 ?person2)
           (lisp-value comes-before? ?person1 ?person2)))

;;;;;;;;;;
;; 4.61 ;;
;;;;;;;;;;

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

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

;;;;;;;;;;
;; 4.62 ;;
;;;;;;;;;;

;; my-last-pair is specified by two properties:
;; 1. a single element list is its own last pair
;; 2. the last pair of a list is the last pair of its non-empty cdr

(rule (my-last-pair (?x) (?x)))
(rule (my-last-pair (?y . ?x))
      (and (my-last-pair ?x)
           (not (same ?x '()))))

;;;;;;;;;;
;; 4.63 ;;
;;;;;;;;;;

(rule (grandson ?grandfather ?grandson)
      (and (son ?father ?grandson)
           (son ?grandfather ?father)))

(rule (father ?son ?father)
      (and (wife ?father ?wife)
           (son ?wife ?son)))

(grandson Cain ?x)

(father ?x Lamech)

(grandson Methushael ?x)