;; Homework Assignment 6 Solutions

;; Make sure they have comments, test cases, and good function names!

;; Part 1 (7 points)

;; Access Functions, also called Selector Functions (1 point)
;; 1 point off if they don't have any.  
(define get-last-name car)
(define get-first-name cadr)
(define entry car)
(define get-employee-name car)
(define get-job-title cadr)
(define get-date-appointed caddr)

;; Part a 

;; First Version of JOB-DATA (1 point)
(define (job-data name db)
  (cond
   ((null? db) #f)
   ((equal? (get-employee-name (entry db)) name)
    (cdr (entry db)))
   (else 
    (job-data name (cdr db)))))

;; Second Version of JOB-DATA (1 point)
;; If they don't check if the name is not there, mark them off .5 points.
;; The description of JOB-DATA says that if you take in a name that is 
;; not in the database, it should return #f. 
(define (job-data name db)
  (if (assoc name db)
      (cdr (assoc name db))
      #f))

;; Part b
;; (1 point)
(define (job-title job db)
  (cond
   ((null? db) '())
   ((equal? (get-job-title (entry db)) job)
    (cons (get-employee-name  (entry db)) 
	  (job-title job (cdr db))))
   (else
    (job-title job (cdr db)))))

;; (1 point)
(define (longest-employed db)
  (le-helper (cdr db) (entry db)))

(define (le-helper db so-far)
  (cond
   ((null? db) (get-employee-name so-far))
   ((> (time-employed (entry db)) (time-employed so-far))
    (le-helper (cdr db) (entry db)))
   (else (le-helper (cdr db) so-far))))

(define (time-employed entry)
  (days-between (get-date-appointed entry) '(december 31 2000)))

;; DAYS-BETWEEN Code
(define (days-between earlier-date later-date)
    (+ 1 (- (day-of-century later-date) (day-of-century earlier-date))) )

(define (day-of-century date)
    (+ (days-preceding-year (year-in-century date))
       (days-preceding-month (month-name date) (year-in-century date))
       (date-in-month date)))

(define (days-preceding-year year)
  (+ (* 365 (- year 1))
     (quotient (- year 1) 4)))

(define (days-preceding-month month year)
  (if (leap-year? year)
    (item (month-number month)
          '(0 31 60 91 121 152 182 213 244 274 305 335))
    (item (month-number month)
          '(0 31 59 90 120 151 181 212 243 273 304 334))))

(define (leap-year? year)
  (= (remainder year 4) 0))

(define (month-name date) (first date))
(define (date-in-month date) (first (bf date)))
(define (year-in-century date) (first (bf (bf date))))

(define (month-number month)
  (cond
    ((equal? month 'january) 1)
    ((equal? month 'february) 2)
    ((equal? month 'march) 3)
    ((equal? month 'april) 4)
    ((equal? month 'may) 5)
    ((equal? month 'june) 6)
    ((equal? month 'july) 7)
    ((equal? month 'august) 8)
    ((equal? month 'september) 9)
    ((equal? month 'october) 10)
    ((equal? month 'november) 11)
    ((equal? month 'december) 12) ) )

;; Part c
;; (2 points) -  1 point off if they didn't account for the same last name.
(define (sorted-by-employee-name? db)
  (cond
   ((empty? db) #t) 
   ((empty? (cdr db)) #t)
   ((equal? (get-last-name (get-employee-name (entry db)))
	    (get-last-name (get-employee-name (entry (cdr db)))))
    (and (before? (get-first-name (get-employee-name (entry db)))
		  (get-first-name (get-employee-name (entry (cdr db)))))
	 (sorted-by-employee-name? (cdr db))))
   ((before? (get-last-name (get-employee-name (entry db)))
	     (get-last-name (get-employee-name (entry (cdr db)))))
    (sorted-by-employee-name? (cdr db)))
   (else #f)))

;; Test databases - Use these if you need to show a student why
;; some of their code doesn't work
(define db1 
  '(((potatohead mister) actor (july 1 1995) 40000)
    ((lightyear buzz) actor (july 1 1995) 100000)
    ((riviera nick) doctor (january 31 1992) 50000)
    ((epstein juan) student (august 30 1978) 100000)
    ((barbarino vinnie) student (august 31 1978) 10000)))
				    
(define db2 
  '(((chandley tom) invetigator (october 8 1969) 1000000)
    ((checo dwayne) janitor (july 4 1977) 125000)
    ((english jamie) athlete (may 17 1972) 80000)
    ((vanhel richard) researcher (february 29 1972) 75000)))
  
(define db3 
  '(((chandley tom) invetigator (october 8 1969) 1000000)
    ((checo dwayne) janitor (july 4 1977) 125000)
    ((checo wayne) janitor (july 4 1977) 125000)
    ((english jamie) athlete (may 17 1972) 80000)
    ((vanhel richard) researcher (february 29 1972) 75000)))

(define db4 
  '(((chandley tom) invetigator (october 8 1969) 1000000)
    ((checo wayne) janitor (july 4 1977) 125000)
    ((checo dwayne) janitor (july 4 1977) 125000)
    ((english jamie) athlete (may 17 1972) 80000)
    ((vanhel richard) researcher (february 29 1972) 75000)))
(define db5 
  '(((chandley tom) invetigator (october 8 1969) 1000000)
    ((english jamie) athlete (may 17 1972) 80000)
    ((checo dwayne) janitor (july 4 1977) 125000)
    ((vanhel richard) researcher (february 29 1972) 75000)))

;; Part II (3 points)

;; 2 points for the code  
(define (shuffle deck)
  (let ((halves (divide deck)))
    (zip (car halves) (cadr halves))))

(define (divide deck)
  (divide-helper deck '()))

(define (divide-helper first-half second-half)
  (if (equal? (count first-half) (count second-half))
      (list second-half first-half)
      (divide-helper (bf first-half) (se second-half (first first-half)))))

(define (zip s1 s2)
  (if (empty? s1)
      '()
      (se (first s1) (first s2) (zip (bf s1) (bf s2)))))

;; 1 point for finding the smallest number of perfect shuffles it takes to
;; get back to the original deck.

;; LKN 07/01