;; This is the code for Problem Set 6

;; Lookup, insert and delete of NJ-AIR
;;   See R5RS for definition of assq, memq if you haven't seen them before
;;   need your memory refreshed.

(define (lookup-unordered name file)
  (cond ((empty? file) #f)
	((eq? (person-at-curr-folder file) name) (curr-folder file))
	(else (lookup-unordered name (rest file)))))

(define (insert-unordered name record file)
  (let ((pair (attach name record)))
    (cond ((empty? file) (attach pair empty))
	  ((eq? (person-at-curr-folder file) name) ; only one person has a 
	   (attach pair (rest file)))	           ; particular name...
	  (else (attach (curr-folder file)
			(insert-unordered name record (rest file)))))))

(define (delete-unordered name file)
    (cond ((empty? file) file)
	  ((eq? (person-at-curr-folder file) name)
	   (rest file))
	  (else (attach (curr-folder file)
		        (delete-unordered name (rest file))))))

;;; Abstraction definitions

(define attach cons)
(define curr-folder car)
(define rest cdr)
(define person-at-curr-folder caar)
(define empty? null?)
(define empty '())

;;; Oops, lookup, insert and delete for People-Delay-Airline is destroyed
;;; in a fire.

(define name-string symbol->string)	;one undestroyed procedure

;;; Lookup, insert and delete for Epsilon-Air

(define (lookup-tree name file)
  (let ((next-branch (choose-branch name file)))
    (cond ((null? next-branch) #f)
	  ((leaf? next-branch) (content next-branch))
	  (else (lookup-tree name next-branch)))))

(define (choose-branch name file)
  (let ((left-branch (left file))
	(right-branch (right file)))
    (cond ((memq name (symbols left-branch)) left-branch)
	  ((memq name (symbols right-branch)) right-branch)
	  (else nil))))







(define (insert-tree name record file)
  (if (empty? file)
      (insert-tree name record (make-tree nil nil))
      (let ((path (choose-path name file))
	    (leaf (make-leaf name record)))
	(if (null? path)
	    (let ((r (random 2)))
	      (if (= r 1)
		  (cond ((bare? (left file))
			 (make-tree leaf (right file)))
			((leaf? (left file))
			 (make-tree (make-tree leaf (left file))
				    (right file)))
			(else
			 (make-tree (insert-tree name record (left file))
				    (right file))))
		  (cond ((bare? (right file))
			 (make-tree (left file) leaf))
			((leaf? (right file))
			 (make-tree (left file)
				    (make-tree (right file) leaf)))
			(else
			 (make-tree (left file)
				    (insert-tree name record (right file)))))))
	    (if (leaf? (choose-branch name file))
		(if (eq? path 'left)
		    (make-tree leaf (right file))
		    (make-tree (left file) leaf))
		(if (eq? path 'left)
		    (make-tree (insert-tree name record (left file))
			       (right file))
		    (make-tree (left file)
			       (insert-tree name record (right file)))))))))

(define (delete-tree name file)
  (let ((path (choose-path name file)))
    (cond ((eq? 'left path)
	   (if (leaf? (left file))
	       (if (bare? (right file))
		   nil
		   (make-tree nil (right file)))
	       (make-tree (delete-tree name (left file))
			  (right file))))
	  ((eq? 'right path)
	   (if (leaf? (right file))
	       (if (bare? (left file))
		   nil
		   (make-tree (left file) nil))
	       (make-tree (left file)
			  (delete-tree name (right file)))))
	  (else file))))

(define (choose-path name file)
  (cond ((memq name (symbols (left file))) 'left)
	((memq name (symbols (right file))) 'right)
	(else nil)))







;;; Structuring a tree (abstraction definitions for Epsilon-Air)

(define (make-tree left right)
  (list left right (append (symbols left) (symbols right))))

(define left car)
(define right cadr)

(define (make-leaf name record)
  (list 'leaf (cons name record)))

(define (symbols tree)
  (cond ((bare? tree) nil)
	((leaf? tree) (list (symbol tree)))
        (else (caddr tree))))

(define (leaf? obj)
  (eq? (car obj) 'leaf))

(define (bare? obj)
  (null? obj))

(define nil '())

(define (symbol obj)
  (caadr obj))

(define (content obj)
  (cadr obj))

;;; Constructor of NJ-AIR and People-Delay Airline's employee record

(define (make-record-table id info)
  (list (cons id info)))

;;; Constructor of Epsilon-Air's employee record

(define (make-record-tree id info)
  (make-tree (make-leaf id info) nil))

;;; All the Personel files (minaturized versions)

;; individual databases, untagged.

(define nj-air-database
  (list
   (list 'moe (cons 'salary 40000) '(address 88 martin st))
   (list 'joe (cons 'salary 30000) '(address 77 salem st))))

(define people-delay-database
  (list
   (list 'jane '(address 350 woodcock st)
	 (cons 'salary 34000))
   (list 'ruth '(address 90 sparks st))))

(define epsilon-air-database
  (list
   '(leaf (bob ((leaf (address 23 bachman st))
		(leaf (salary . 45300))
		(address salary))
	       ()
	       (address salary)))
   '(leaf (amy ()
	       (leaf (address 79 emery st))
	       (address)))
   '(bob amy)))


;; supplied tagging routines

(define attach-tag cons)

(define tag-of car)

(define contents-of cdr)

(define (tagged-as? expected-tag x)
  (and (pair? x) (equal? (tag-of x) expected-tag)))


;; tags for various databases

(define nj-air-tag 'nj-air)
(define people-delay-tag 'people-delay)
(define epsilon-air-tag 'epsilon-air)

;; tagged databases

(define nj-air (attach nj-air-tag nj-air-database))

(define people-delay (attach people-delay-tag people-delay-database))

(define epsilon-air (attach epsilon-air-tag epsilon-air-database))


;; combined-database for final problem:

(define personnel-file (list nj-air people-delay epsilon-air))