;;; vivek.ss
;;;   Primary utilities for Vivek's "Love Your Body" Dating Service
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   1.1 of October 2000
;;; Contents:
;;;   Generic Utilities
;;;     (intersect list1 list2)
;;;       Compute the intersection of two lists of symbols.
;;;   Extract People Information
;;;     (get-datee-first-name person)
;;;       Get someone's first name.
;;;     (get-datee-last-name person)
;;;       Get someone's last name.
;;;     (get-datee-full-name person)
;;;       Get someone's full name.
;;;     ...
;;;   Person Utilities
;;;     (same-person? person1 person2)
;;;       Decide if two people are the same.
;;;     (lookup-by-first-name name datees)
;;;       Find someone who has the given first name.
;;;     (dates-gender person gender)
;;;       Determine if a person dates a particular gender.
;;;     (compatible? person1 person2)
;;;       Determine if two people are compatible.
;;;     (suggest-dates person datees)
;;;       Create a list of possible dates for a person.
;;;   Tests
;;;     (sample-dates)
;;;       Create a list of sample dates.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Library files

;;; This library contains our database of prospective clients.  
;;; It defines the variable "datees".
(load "datees.ss")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generic utilities

;;; Get the "intersection" of two lists of strings.  The
;;; intersection contains all the strings that appear in both
;;; lists.
;;; Preconditions:
;;;   Both lists contain only strings.
;;; Postconditions:
;;;   Affects neither list.
;;; Returns:
;;;   A list that contains the strngs that appear at least once
;;;   in each list.  If a string appears multiple times in one 
;;;   list, it may appear multiple times in the intersection.
(define intersect
  (lambda (list1 list2)
    ;;; Base case: The first list is empty; no intersection.
    (if (null? list1) null
        ;;; Recursive case.  If the first thing in the first list
        ;;; is in the second list, keep it in the intersection,
        ;;; o/w, continue on with the rest of the first list.
        (let ((first (car list1))
              (rest (intersect (cdr list1) list2)))
          (if (member first list2) (cons first rest) rest)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extracting information from people

;;; Get a person's first name, last name, full name, gender, 
;;; preferred dating gender, age, characteristics, likes, or
;;; desires.
;;; Parameters:
;;;   The record for a person
;;; Preconditions:
;;;   The record is in the correct format.
;;; Postconditions:
;;;   That record has not been modified.
;;;   Returns the appropriate value.
;;; Note:
;;;   These routines are intended to make my other code more
;;;   readable.  While they take longer to type, they are easier
;;;   to read.  Their presence also makes it easier to update
;;;   my code.
(define get-datee-first-name
  (lambda (person) (list-ref person 0)))

(define get-datee-last-name
  (lambda (person) (list-ref person 1)))

(define get-datee-full-name
  (lambda (person)
    (string-append (get-datee-first-name person)
                   " "
                   (get-datee-last-name person))))
                   
(define get-datee-gender
  (lambda (person) (list-ref person 2)))

(define get-datee-prefers
  (lambda (person) (list-ref person 3)))

(define get-datee-age
  (lambda (person) (list-ref person 4)))

(define get-datee-characteristics
  (lambda (person) (list-ref person 5)))

(define get-datee-likes
  (lambda (person) (list-ref person 6)))

(define get-datee-desires
  (lambda (person) (list-ref person 7)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Person utilities

;;; Determine if two people are the same.
;;; Parameters:
;;;   Two people.
;;; Preconditions:
;;;   Both people are in the approved form.
;;; Postconditions:
;;;   Does not affect either person.
;;; Returns:
;;;   True if they are equal and false otherwise.
;;; Note:
;;;   Initially, we use "same name" for equality.
(define same-person?
  (lambda (alpha beta)
    (equal? (get-datee-full-name alpha) 
            (get-datee-full-name beta))))
            
;;; Look up a person by first name.
;;; Parameters:
;;;   The person's first name
;;;   A list of people
;;; Returns:
;;;   The record for a person with that name, if one exists.
;;;   #f, otherwise
;;; Preconditions:
;;;   The name is a string.
;;;   The list contains only people records.
;;; Postconditions:
;;;   If at least one person has the specified first name, 
;;;     returns *one* of those people.
;;;   Does not affect the list.
;;; Note:
;;;   Used primarily for quick testing.
(define lookup-by-first-name
  (lambda (name lst)
    (cond
      ((null? lst) #f)
      ((equal? name (get-datee-first-name (car lst)) (car lst))
      (else (lookup-by-first-name name (cdr lst)))))))

;;; See if a person dates a particular gender.
;;; Parameters:
;;;   A person
;;;   A gender
;;; Preconditions:
;;;   The person is in the specified list form (first name, last
;;;     name, ...).
;;;   The gender is either the symbol 'male or the symbol 'female.
;;; Postconditions:
;;;   Does not affect the person.
;;; Returns:
;;;   True if the person dates that gender and false otherwise.
(define dates-gender
  (lambda (person gender)
    (let ((prefers (get-datee-prefers person)))
      (or (equal? prefers 'both) (equal? prefers gender)))))
    
;;; See if two people are compatible.
;;; Parameters:
;;;   Two people
;;; Preconditions:
;;;   Each person is in specified list form.
;;; Postconditions:
;;;   Neither person is affected.
;;; Returns:
;;;   True if they are compatible and false otherwise.
(define compatible?
  (lambda (alpha beta)
    (let* ((alpha-gender (get-datee-gender alpha))
           (beta-gender (get-datee-gender beta))
           (alpha-likes (get-datee-likes alpha))
           (beta-likes (get-datee-likes beta))
           (common-likes (intersect alpha-likes beta-likes)))
      (and (dates-gender alpha beta-gender)
           (dates-gender beta alpha-gender)
           (not (null? common-likes))))))
           
;;; Given a person, find all the people that are compatible with
;;; that persron.
;;; Parameters:
;;;   A person
;;;   A list of potential mates.
;;; Preconditions:
;;;   The person is in the appropriate form.
;;;   Each member of the list is in the appropriate person form.
;;; Postconditions:
;;;   Does not affect the parameters.
;;; Returns:
;;;   A (possibly-empty) list of potential datees.
(define suggest-dates
  (lambda (person datees)
    (if (null? datees) null
        (let ((tryme (car datees))
              (rest (suggest-dates person (cdr datees))))
          (if (and (compatible? person tryme)
                   (not (same-person? person tryme)))
              (cons tryme rest)
              rest)))))
           
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tests

(define sample-dates
  (lambda ()
    (suggest-dates (car datees) datees)))