;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-reader.ss" "lang")((modname 14.1.1) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp")))))
;A child structure is
;(make-child father mother name date eyes) where
;
;1. name and eyes are symbols,
;2. date is a number,
;3. and father and mother are either
;a. child structures or 
;b. empty.
;
(define-struct child (father mother name date eyes))
;
;A family tree node (ftn) is either
;1. empty or
;2. (make-child father mother name date eyes) where
;a. father and mother are ftn,
;b. name and eyes are symbols,
;c. and date is a number.
;

(define Carl (make-child empty empty 'Carl 1926 'green))
(define Bettina (make-child empty empty 'Bettina 1926 'green))
(define Adam (make-child Carl Bettina 'Adam 1950 'yellow))
(define Dave (make-child Carl Bettina 'Dave 1955 'black))
(define Eva (make-child Carl Bettina 'Eva 1965 'blue))
(define Fred (make-child empty empty 'Fred 1966 'pink))
(define Gustav (make-child Fred Eva 'Gustav 1988 'brown))

;Template
;fun-for-ftn : ftn -> ???
;(define (fun-for-ftn a-ftree)
;  (cond
;    [(empty? a-ftree) ...]
;    [else 
;     ... (fun-for-ftn (child-father a-ftree)) ...
;     ... (fun-for-ftn (child-mother a-ftree)) ...
;     ... (child-name a-ftree) ...
;     ... (child-date a-ftree) ...
;     ... (child-eyes a-ftree) ...]))

;blue-eyed-ancestor? : ftn -> boolean
;Given a-ftree, determine if there is
;a child in a-ftree with 'blue in eyes field.
(define (blue-eyed-ancestor? a-ftree)
  (cond
    [(empty? a-ftree) false]
    [else 
     (or
       (symbol=? (child-eyes a-ftree) 'blue)
       (blue-eyed-ancestor? (child-father a-ftree))
       (blue-eyed-ancestor? (child-mother a-ftree)))]))

;count-persons : ftn -> number
;Given a-ftree, determines the number of people in the
;family tree.

;Examples:
;(count-persons Carl)
;1
;(count-persons Dave)
;3

(define (count-persons a-ftree)
  (cond
    [(empty? a-ftree) 0]
    [else 
     (+ 1
        (count-persons (child-father a-ftree))
        (count-persons (child-mother a-ftree)))]))
;
;average-age : ftn -> number
;Computes the average age of all the people
;in a family tree.  Sums the ages
;and divides by the count of persons.

(define (average-age a-ftree)
  (/ (sum-of-ages a-ftree)
     (count-persons a-ftree)))
;
;sum-of-ages : ftn -> number
;Computes the sum of the ages of
;the people in a family tree.
;
;Examples:
;(sum-of-ages Carl)
;83
;(sum-of-ages Eva)
;210

(define CURRENTYEAR 2009)

(define (sum-of-ages a-ftree)
  (cond
    [(empty? a-ftree) 0]
    [else 
     (+ (- CURRENTYEAR (child-date a-ftree))
        (sum-of-ages (child-father a-ftree))
        (sum-of-ages (child-mother a-ftree)))]))

;A list-of-eye-colors is either
;1. an empty list or
;2. (cons ec loec) where ec is a symbol and
;loec is a list-of-eye-colors.
;(alternatively written as (list ec1 ec2 ... empty)
;where each argument represents a symbol).
;
;eye-colors : ftn -> list-of-eye-colors

(define (eye-colors a-ftree)
  (cond
    [(empty? a-ftree) empty]
    [else (append
           (list (child-eyes a-ftree))
           (eye-colors (child-father a-ftree))
           (eye-colors (child-mother a-ftree)))]))

;proper-blue-eyed-ancestor? : ftn -> boolean
;Given a-ftree, determine if the person
;has a proper blue eyed ancestor
;(someone in the family tree with blue eyes
; who is not the person in question)

(define (proper-blue-eyed-ancestor? a-ftree)
  (cond
    [(empty? a-ftree) false]
    [else (or (blue-eyed-ancestor? (child-father a-ftree))
              (blue-eyed-ancestor? (child-mother a-ftree)))]))