;;; File:
;;;   37.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   Sample code from class 37 (higher-order procedures)

; +---------------------+---------------------------------------------
; | Stuff from the exam |
; +---------------------+

(define student-info
  (lambda (last-name first-name year smokes? bedtime politics color)
    (cond 
      ((not (string? last-name))
       (error "student-info: first parameter (last-name) must be a string"))
      ((not (string? first-name))
       (error "student-info: second parameter (first-name) must be a string"))
      ((or (not (integer? year)) (< year 1) (> year 4))
       (error "student-info: third parameter (year) must be an integer between 1 and 4"))
      ((not (boolean? smokes?))
       (error "student-info: fourth parameter (smokes?) must be a boolean"))
      ((not (member bedtime (list 'early 'late)))
       (error "student-info: fifth parameter (bedtime) must be 'early or 'late"))
      ((not (member politics (list 'liberal 'conservative)))
       (error "student-info: sixth parameter (politics) must be 'liberal or 'conservative"))
      ((not (string? color))
       (error "student-info: seventh parameter (color) must be a string"))
      (else 
       (vector last-name first-name year smokes? bedtime politics color)))))

(define get-last-name
  (lambda (student)
    (vector-ref student 0)))
(define get-first-name
  (lambda (student)
    (vector-ref student 1)))
(define get-year
  (lambda (student)
    (vector-ref student 2)))
(define smokes?
  (lambda (student)
    (vector-ref student 3)))
(define get-bedtime
  (lambda (student)
    (vector-ref student 4)))
(define get-politics
  (lambda (student)
    (vector-ref student 5)))
(define get-favorite-color
  (lambda (student)
    (vector-ref student 6)))

(define joe-smith #7("Smith" "Joe" 1 #f early conservative "blue"))
(define jane-jones #7("Jones" "Jane" 2 #t late liberal "yellow"))
(define dee-doe (student-info "Doe" "Dee" 2 #t 'early 'liberal "yellow"))
(define vivek (student-info "Venugopal" "Vivek" 4 #f 'late 'liberal "katie"))

; +---------------+---------------------------------------------------
; | Favorite HOPs |
; +---------------+

(define compose
  (lambda (f g)
    (lambda (x)
      (f (g x)))))

(define left-section
  (lambda (func left)
    (lambda (right)
      (func left right))))
(define l-s left-section)

(define right-section
  (lambda (func right)
    (lambda (left)
      (func left right))))

(define map
  (lambda (fun lst)
     (if (null? lst)
         null
         (cons (fun (car lst))
               (map fun (cdr lst))))))

; +----------------+--------------------------------------------------
; | File Procesing |
; +----------------+

(define recursive-read-file-proc
  (letrec ((kernel (lambda (input-port)
                     (let ((val (read input-port)))
                       (cond
                         ((eof-object? val)
                          (close-input-port input-port)
                          (BASE-CASE))
                         (else
                          (COMBINE val (kernel input-port))))))))
    (lambda (fname)
      (kernel (open-input-file fname)))))

; +-----------------+-------------------------------------------------
; | Work from Class |
; +-----------------+

; Need to define good-match
; First defnie some helpers
(define count-smokes (lambda (s1 s2) (count-X smokes? s1 s2)))
(define count-bedtime (lambda (s1 s2) (count-X get-bedtime s1 s2)))

(define count-X (lambda (X s1 s2) (if (equal? (X s1) (X s2)) 1 0)))

; Can we write w/o copying and pasting?  Yes.  See above
; Now, we don't even need to write count-smokes

(define compatible-characteristics?
  (lambda (s1 s2)
    (>= (+ (count-X smokes? s1 s2) 
           (count-X get-bedtime s1 s2) 
           (count-X get-politics s1 s2) 
           (count-X get-favorite-color s1 s2)
           (count-X (lambda (s1) (if (member (get-year s1) (list 1 2)) 'young 'old)) s1 s2))
        
        3)))

(define ageist
  (lambda (s1)
    (if (member (get-year s1) (list 1 2)) 'young 'old)))